Перекинуть Label из окна в контейнер пользовательского контрола - VB

Формулировка задачи:

Добрый день сейчас самостоятельно разрабатываю компонент Спойлер.. исходники здесь модификация здесь:

Option Explicit
'
'   © Антихакер32™
'
Private Const def_cm1_Height = 300 'Высота кнопки
Private Const HWND_TOPMOST = -1
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_TOOLWINDOW = 128
'
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Sub SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)
Private Declare Function GetForegroundWindow Lib "user32" () As Long
'
Dim WithEvents cm1 As CommandButton
Dim WithEvents Pic As PictureBox
Dim Amb As Object
Dim mSpoilerAction As Boolean
'''''Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
'''''Private Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
'''''Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
'''''Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
 
Public Sub WActivate()
    On Error GoTo errr
    SpoilerAction = False
errr:
End Sub
 
Public Sub WindowPosChaning()
    On Error GoTo errr
    Const ram = 60
    Static Left&, top&
    Left = Parent.Left - (Parent.ScaleWidth - Parent.Width + ram) + Amb.Left
    top = Parent.top - (Parent.ScaleHeight - Parent.Height + ram) + Amb.top + cm1.Height
    Pic.Move Left, top, Amb.Width, Amb.Height - cm1.Height
errr:
End Sub
 
Private Property Get SpoilerAction() As Boolean
    SpoilerAction = mSpoilerAction
End Property
 
Private Property Let SpoilerAction(ByVal vNewValue As Boolean)
    mSpoilerAction = vNewValue
    If vNewValue Then
        SetWindowPos Pic.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE
        Pic.Visible = True
    Else
        SetWindowPos Pic.hWnd, 0, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE
        Pic.Visible = False
    End If
End Property
 
Private Sub cm1_Click()
    SpoilerAction = Not SpoilerAction
End Sub
 
Private Sub UserControl_ExitFocus()
SpoilerAction = False
End Sub
 
Private Sub UserControl_Initialize()
    Set cm1 = Controls.Add("vb.CommandButton", "cm1_" & hWnd)
    cm1.Visible = 1
    Set Pic = Controls.Add("vb.PictureBox", "pic_" & hWnd)
End Sub

Private Sub UserControl_Resize()
    On Error Resume Next
    cm1.Move 0, 0, Width, def_cm1_Height
    Pic.Move 0, cm1.Height, Width, Height - cm1.Height
End Sub
 
Private Sub UserControl_Show()
    Dim j$(), id$, indAmb&, o As Object, hW&, py&
    j = Split(Ambient.DisplayName, "(")
 
    If UBound(j) Then
         indAmb = Val(Split(j(1), ")")(0))
        Set Amb = CallByName(Parent, j(0), VbGet, indAmb)
    Else: indAmb = -1
        Set Amb = CallByName(Parent, j(0), VbGet)
    End If
    On Error Resume Next
    If Ambient.UserMode Then
        For Each o In Parent
            id = o.Container.Name 'Если произойдет ошибка, то останеться это id
            id = id & "(" & o.Container.Index & ")"
            If id = Ambient.DisplayName Then
                hW = 0: hW = o.hWnd
                If hW = 0 Then
                    '
                    'Здесь лейбл, значит надо напечатать на PictureBox эту надпись :(
                    '
                Else: SetParent hW, Pic.hWnd
                End If
                
                o.top = o.top - def_cm1_Height
            End If
        Next
        SetParent Pic.hWnd, 0
        SetWindowLong Pic.hWnd, GWL_EXSTYLE, _
        GetWindowLong(Pic.hWnd, GWL_EXSTYLE) Or WS_EX_TOOLWINDOW
        WindowPosChaning
        Hook Amb
    Else 'Режим проектирования
        SetParent Pic.hWnd, hWnd
        Pic.Visible = True: Pic.Enabled = 0
        Pic.ZOrder 1
    End If
End Sub
 
Private Sub UserControl_Terminate()
     UnHook
End Sub

Option Explicit
'
Public Const GWL_WNDPROC = -4
' Сообщения windows
Public Const WM_CLOSE = &H10
Private Const WM_MOVE = &H3
 
Const WM_ACTIVATE = &H6
 
Const HTCAPTION = 2
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
'
Dim SWL As Long
Dim mTypeName As String
Dim mParent  As Object
Dim mParent_hWnd As Long

Function Hook(Child As Object) As Long
    On Error GoTo errr
    If Child.Parent.hWnd <> mParent_hWnd Then
        mTypeName = TypeName(Child)
        Set mParent = Child.Parent
        mParent_hWnd = mParent.hWnd
        SWL = SetWindowLong(mParent_hWnd, GWL_WNDPROC, AddressOf WindowProc)
    End If
errr:
End Function
 
Sub UnHook()
    Call CallWindowProc(SWL, mParent_hWnd, WM_CLOSE, 0, 0)
End Sub
 
Public Function WindowProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   Dim o As Object
   On Error GoTo errr
   Select Case Msg
   Case WM_ACTIVATE
        For Each o In mParent
            If TypeName(o) = mTypeName Then
                Call o.WActivate
            End If
        Next
        Exit Function
    Case WM_MOVE
        For Each o In mParent
            If TypeName(o) = mTypeName Then
                Call o.WindowPosChaning
            End If
        Next
        Exit Function
   End Select
   WindowProc = CallWindowProc(SWL, hWnd, Msg, wParam, lParam)
errr:
End Function

так вот, есть ли нормальный способ чтоб перекинуть лейбл из окна в контейнер пользовательского контрола

Там проблемное место, это 101-я строчка, в модуле UserControl'а ..Какие будут предложения коллеги ?

вот как я придумал пока сделать, но это решение меня мало радует

Private Sub UserControl_Show()
    Dim j$(), id$, indAmb&, o As Object, hW&, hP&
    Dim lab As Label, col As Collection, f&, v As Object
    j = Split(Ambient.DisplayName, "(")
 
    If UBound(j) Then
         indAmb = Val(Split(j(1), ")")(0))
        Set Amb = CallByName(Parent, j(0), VbGet, indAmb)
    Else: indAmb = -1
        Set Amb = CallByName(Parent, j(0), VbGet)
    End If
    On Error Resume Next
    If Ambient.UserMode Then
        For Each o In Parent
            id = o.Container.Name 'Если произойдет ошибка, то останеться это id
            id = id & "(" & o.Container.Index & ")"
            If id = Ambient.DisplayName Then
                hW = 0: hW = o.hWnd
                hP = GetParent(hW)
                If hW = 0 Then
                    '
                    'Здесь лейбл, значит
                    '
                    Set lab = Controls.Add("vb." & TypeName(o), "lab_" & hWnd, Pic)
                    With lab
                        .Alignment = o.Appearance
                        .Appearance = o.Appearance
                        .AutoSize = o.AutoSize
                        .BackColor = o.BackColor
                        .BorderStyle = o.BorderStyle
                        .Left = o.Left
                        .top = o.top
                        .Width = o.Width
                        .Height = o.Height
                        .Font = o.Font
                        .Caption = o.Caption
                        o.Visible = False
                        .Visible = True
                    End With
 
                ElseIf hP = hWnd Then
                    SetParent hW, Pic.hWnd
                End If
                o.top = o.top - def_cm1_Height
            End If
        Next
        SetParent Pic.hWnd, 0
        SetWindowLong Pic.hWnd, GWL_EXSTYLE, _
        GetWindowLong(Pic.hWnd, GWL_EXSTYLE) Or WS_EX_TOOLWINDOW
        WindowPosChaning
        Hook Amb
    Else 'Режим проектирования
        SetParent Pic.hWnd, hWnd
'        Pic.Visible = True: Pic.Enabled = 0
        Pic.ZOrder 1
    End If
End Sub

Решение задачи: «Перекинуть Label из окна в контейнер пользовательского контрола»

textual
                            Листинг программы 
                        

                            Option Explicit
'
'   © Антихакер32™
'
'
Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
'
Public Enum FlagsSpoilerStyle
    [По умолчанию] = 0
    [Кнопка слева] = 1
End Enum
'
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Sub SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)
Private Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
'
'Default Property Values:
Const m_def_Style = 0
Const def_Exp = 280 'Высота кнопки
Const HWND_TOPMOST = -1
Const SWP_NOSIZE = &H1
Const SWP_NOMOVE = &H2
Const GWL_EXSTYLE = (-20)
Const WS_EX_TOOLWINDOW = 128
'Property Variables:
Dim m_Style As FlagsSpoilerStyle
Dim WithEvents cm1 As CommandButton
Dim sh1 As Shape
Dim mSpoilerAction As Boolean
Dim oldParRect As RECT, mRect As RECT
Dim ResizeAction As Boolean
 
Public Sub WActivate()
    On Error GoTo errr
    If SpoilerAction Then SpoilerAction = False
errr:
End Sub
 
Public Sub WMove()
    Static Rect1 As RECT, Rect2 As RECT
    On Error GoTo errr
    If mSpoilerAction Then
        GetWindowRect Parent.hWnd, Rect1
        GetWindowRect hWnd, Rect2
        With Rect2
            .Left = .Left + (Rect1.Left - oldParRect.Left)
            .Top = .Top + (Rect1.Top - oldParRect.Top)
            SetWindowPos hWnd, -1, .Left, .Top, 0, 0, SWP_NOSIZE
        End With
        oldParRect = Rect1
    End If
errr:
End Sub
 
Private Property Get SpoilerAction() As Boolean
    SpoilerAction = mSpoilerAction
End Property
 
 
Private Property Let SpoilerAction(ByVal vNewValue As Boolean)
    Static Rect1 As RECT, Rect2 As RECT, Rect3 As RECT, Border&
    On Error GoTo errr
    GetWindowRect Parent.hWnd, Rect1
    GetWindowRect hWnd, Rect2
    ResizeAction = True
    If vNewValue Then
        With Rect2
            .Left = Rect1.Left + (.Left - Rect1.Left)
            .Top = Rect1.Top + (.Top - Rect1.Top)
            SetWindowPos hWnd, 0, .Left, .Top, 0, 0, SWP_NOSIZE
            SetParent hWnd, 0
            oldParRect = Rect1
        End With
        Select Case m_Style
        Case [По умолчанию]: Height = sh1.Height
        Case [Кнопка слева]: Width = sh1.Width
        End Select
    Else
        GetClientRect Parent.hWnd, Rect3
        With Rect2
            .Left = (.Left - (Rect1.Right - Rect3.Right))
            .Left = .Left + (mRect.Left - .Left)
            .Top = (.Top - (Rect1.Bottom - Rect3.Bottom))
            .Top = .Top + (mRect.Top - .Top)
            SetParent hWnd, Parent.hWnd
            SetWindowPos hWnd, 0, .Left, .Top, 0, 0, SWP_NOSIZE
        End With
        Select Case m_Style
        Case [По умолчанию]: Height = def_Exp
        Case [Кнопка слева]: Width = def_Exp
        End Select
    End If
    mSpoilerAction = vNewValue
errr:
    ResizeAction = False
End Property
 
Private Sub cm1_Click()
    SpoilerAction = Not SpoilerAction
End Sub
 
Private Sub UserControl_Initialize()
    Set cm1 = Controls.Add("vb.CommandButton", "cm1_" & hWnd)
    Set sh1 = Controls.Add("vb.Shape", "sh1_" & hWnd)
    sh1.Visible = 1: cm1.Visible = 1
    SetWindowLong hWnd, GWL_EXSTYLE, _
    GetWindowLong(hWnd, GWL_EXSTYLE) Or WS_EX_TOOLWINDOW
End Sub
 
Private Sub UserControl_Resize()
    On Error Resume Next
    If ResizeAction Then Exit Sub
    With mRect
        If Not mSpoilerAction Then
            sh1.Move 0, 0, Width, Height
            .Left = Extender.Left \ Screen.TwipsPerPixelX
            .Top = Extender.Top \ Screen.TwipsPerPixelY
        End If
        Select Case m_Style
        Case [По умолчанию]: cm1.Move 0, 0, sh1.Width, def_Exp
        Case [Кнопка слева]: cm1.Move 0, 0, def_Exp, sh1.Height
        End Select
    End With
End Sub
 
Private Sub UserControl_Show()
    Dim o As Object
    If Ambient.UserMode Then
        SpoilerAction = 1
        Hook Extender
    End If
End Sub
 
Private Sub UserControl_Terminate()
     UnHook
End Sub
 
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=8,0,0,0
Public Property Get Style() As FlagsSpoilerStyle
    Style = m_Style
End Property
 
Public Property Let Style(ByVal New_Style As FlagsSpoilerStyle)
    m_Style = New_Style
    PropertyChanged "Style"
    UserControl_Resize
End Property
 
'Initialize Properties for User Control
Private Sub UserControl_InitProperties()
    m_Style = m_def_Style
End Sub
 
'Load property values from storage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    m_Style = PropBag.ReadProperty("Style", m_def_Style)
    UserControl_Resize
End Sub
 
'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
 
    Call PropBag.WriteProperty("Style", m_Style, m_def_Style)
End Sub
                        