'[To make a childform popup on demand as part of a parentform]

'For suggestions,
'E.B. Knoppert, ProFinance WOERDEN Netherlands
'ebknoppert@hotmail.com

// USERCONTROL

Option Explicit

Public Enum ExcboAction

    ExfrmShow
    ExfrmShowStay
    ExfrmHide

End Enum

Private HookParam As ExFrm_HookParam

'The events you'll be using.
Public Event Click(ChildForm As Variant, X As Single, Y As Single)
Public Event Deactivate(ByVal NewhWnd As Long, Cancel As Boolean)
Public Event Resize()

Public Function Action(Optional ByVal Mode As ExcboAction = ExfrmShow) As Boolean

    Dim ChildForm   As Form
    Dim R           As RECT
    Dim X           As Single
    Dim Y           As Single

    Const WM_SHOWWINDOW = &H18
    Const SW_PARENTOPENING = 3

    Select Case Mode
    Case ExfrmShow
    Case ExfrmShowStay
    Case ExfrmHide

        If HookParam.ChildhWnd Then

            'Test for window.
            If IsWindow(HookParam.ChildhWnd) Then

                'Hide it..
                PostMessage HookParam.ChildhWnd, WM_SHOWWINDOW, 0, SW_PARENTOPENING

                ExFrm_UnHook HookParam

                Action = True

            End If

        End If

        HookParam.ChildhWnd = 0

        Exit Function

    Case Else: Exit Function
    End Select

    'We need the parent.
    If Extender.Parent Is Nothing Then Exit Function

    'Determine coordinates of the usercontrol.
    GetWindowRect UserControl.hwnd, R

    'Provide them in the event, you may change these coordinates.
    X = R.Left * Screen.TwipsPerPixelX
    Y = R.Bottom * Screen.TwipsPerPixelY

    'Event is required to retrieve the form we want as child.
    RaiseEvent Click(ChildForm, X, Y)

    If ChildForm Is Nothing Then Exit Function

    'We are using a Variant, we need to verify if it's correctly set to a form.
    If Not TypeOf ChildForm Is Form Then Exit Function

    'Store mode.
    HookParam.ExfMode = Mode

    'We are gonna call the usercontrol from within the module.
    'We need this usercontrol's pointer to call.
    HookParam.pUsercontrol = ObjPtr(Me)

    'Enable hook, provide parent and child.
    If ExFrm_Hook(Extender.Parent, ChildForm, HookParam) Then

        'Set the form to it's new coordinates.
        ChildForm.Move X, Y

        'Show the child as 'real' child of this parent.
        ChildForm.Show , Extender.Parent

    End If

    Action = True

End Function

'Special "friend" method, should be used from within the module only.
'Is used to raise a deactivate event, you can abort hiding by setting "Cancel" to True.
'The "new" hWnd is also provided, hereby you can determine wich window will be active.
Friend Sub Deactivated(ByVal NewhWnd As Long, Cancel As Boolean)

    RaiseEvent Deactivate(NewhWnd, Cancel)

End Sub

Private Sub UserControl_Resize()

    RaiseEvent Resize

End Sub

Public Property Get ScaleWidth() As Single

    ScaleWidth = UserControl.ScaleWidth

End Property

Public Property Get ScaleHeight() As Single

    ScaleHeight = UserControl.ScaleHeight

End Property

Private Sub UserControl_Show()

    RaiseEvent Resize

End Sub

// FORM1

Option Explicit

Private Sub Command1_Click()

    'Activate the usercontrol, you should respond to it's Click event.

    With Me.ExForm1

        If Form2.Visible Then

            .Action ExfrmHide

        Else

            'Here we make the decision to let the form stay after a deactivate or not.
            If Option1(1).Value Then

                .Action ExfrmShowStay

            Else

                .Action

            End If

        End If

    End With

End Sub

Private Sub Command2_Click()

    'Example to hide to form on command.
    Me.ExForm1.Action ExfrmHide

End Sub

Private Sub ExForm1_Click(ChildForm As Variant, X As Single, Y As Single)

    'You MUST specify the childform in this procedure like below;
    'This is done to make just 1 procedure interactive.
    'Not providing a formname will abort.
    Set ChildForm = Form2

    'X and Y are the newly to use coordinates aligned to the usercontrol.
    'You may overide this by reset X and/or Y to your desired values like;

    'Keep child on it's initial positions.
    'X = ChildForm.Left
    'Y = ChildForm.Top

End Sub

Private Sub ExForm1_Deactivate(ByVal NewhWnd As Long, Cancel As Boolean)

    'Set Cancel to True if the window activated is this Form.
    If Option1(2).Value Then Cancel = NewhWnd = Me.hwnd

End Sub

Private Sub ExForm1_Resize()

    'Custom stuff..
    With Me.ExForm1

        Me.Command1.Move .ScaleWidth - .ScaleHeight, 0, .ScaleHeight, .ScaleHeight

        Me.Text1.Move 0, 0, .ScaleWidth - .ScaleHeight, .ScaleHeight

    End With

End Sub

Private Sub Form_Resize()

    Me.ExForm1.Width = Me.ScaleWidth - (Me.ExForm1.Left * 2)

End Sub

//FORM2

Option Explicit

Private Sub File1_Click()

    Form1.Text1 = Dir1.Path & "\" & File1.FileName

End Sub

Private Sub File1_DblClick()

    Me.Hide

End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)

    If KeyAscii = vbKeyEscape Then Me.Hide

End Sub

Private Sub Form_Load()

    Me.KeyPreview = True

    Form_Resize

End Sub

Private Sub Form_Resize()

    Me.Dir1.Top = Me.File1.Top + Me.File1.Height - Me.Dir1.Height

End Sub

// MODULE

Option Explicit

Public Type ExFrm_HookParam

    pUsercontrol            As Long
    ParenthWnd              As Long
    ChildhWnd               As Long
    PrevCallBackProcParent  As Long
    PrevCallBackProcChild   As Long
    ExfMode                 As Long

End Type

Public Type RECT

    Left    As Long
    Top     As Long
    Right   As Long
    Bottom  As Long

End Type

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
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Public Declare Function IsWindow Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
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 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) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Public Const GWL_USERDATA = (-21)
Public Const GWL_WNDPROC = -4

Dim TempUC_ExForm As ExForm

Public Sub ExFrm_UnHook(HookParam As ExFrm_HookParam)

    On Error Resume Next

    Dim lpUserData As Long

    'Hook in process?
    'We are using the GWL_USERDATA entry (parent), be sure you don't use that yourself!
    lpUserData = GetWindowLong(HookParam.ParenthWnd, GWL_USERDATA)

    If lpUserData Then

        SetWindowLong HookParam.ParenthWnd, GWL_WNDPROC, HookParam.PrevCallBackProcParent
        SetWindowLong HookParam.ChildhWnd, GWL_WNDPROC, HookParam.PrevCallBackProcChild
        SetWindowLong HookParam.ParenthWnd, GWL_USERDATA, 0

    End If

End Sub

Public Function ExFrm_Hook(ParentForm As Form, ChildForm As Form, HookParam As ExFrm_HookParam) As Boolean

    On Error Resume Next

    If ParentForm Is Nothing Then Exit Function
    If ChildForm Is Nothing Then Exit Function

    HookParam.ParenthWnd = ParentForm.hwnd
    HookParam.ChildhWnd = ChildForm.hwnd

    'Unhook if hooked.
    ExFrm_UnHook HookParam

    'Determine current window procedure address.
    HookParam.PrevCallBackProcParent = GetWindowLong(ParentForm.hwnd, GWL_WNDPROC)
    HookParam.PrevCallBackProcChild = GetWindowLong(ChildForm.hwnd, GWL_WNDPROC)

    'Store pointer of type in UserData of provided parent.hWnd..
    SetWindowLong ParentForm.hwnd, GWL_USERDATA, VarPtr(HookParam)

    'Enable hook on both forms.
    SetWindowLong ParentForm.hwnd, GWL_WNDPROC, AddressOf ExFrm_WndProc
    SetWindowLong ChildForm.hwnd, GWL_WNDPROC, AddressOf ExFrm_WndProc

    ExFrm_Hook = True

End Function

Function ExFrm_WndProc(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

    On Error Resume Next

    Dim HookParam   As ExFrm_HookParam
    Dim hWndParent  As Long
    Dim IsChild     As Boolean
    Dim lpUserData  As Long
    Dim PrevProc    As Long
    Dim Cancel      As Boolean

    Const GWL_HWNDPARENT = (-8)
    Const SW_PARENTOPENING = 3
    Const WM_ACTIVATE = &H6
    Const WM_NCACTIVATE = &H86
    Const WM_SHOWWINDOW = &H18
    Const SWP_NOMOVE = &H2
    Const SWP_NOSIZE = &H1
    Const SWP_NOZORDER = &H4
    Const SWP_FRAMECHANGED = &H20

    'We receive the messages of both the windows, parent and child.
    'We need a trick to retrieve the type var from the parent if this current msg was meant for the child.
    lpUserData = GetWindowLong(hwnd, GWL_USERDATA)
    If lpUserData = 0 Then

        'It's the child, retrieve userdata from it's parent.
        hWndParent = GetWindowLong(hwnd, GWL_HWNDPARENT)
        If hWndParent Then lpUserData = GetWindowLong(hWndParent, GWL_USERDATA)

        IsChild = True

    End If

    If lpUserData = 0 Then Exit Function

    'Fill type var.
    CopyMemory ByVal VarPtr(HookParam), ByVal lpUserData, LenB(HookParam)

    'Determine correct callback address.
    If IsChild Then

        PrevProc = HookParam.PrevCallBackProcChild

    Else

        PrevProc = HookParam.PrevCallBackProcParent

    End If

    'Respond to childform.
    Select Case wMsg
    Case WM_NCACTIVATE

        wParam = 1

    Case WM_ACTIVATE

        If wParam = 0 And HookParam.ExfMode = ExfrmShow Then

            'Make a temp variable point to the same usercontrol as the current Exform usercontrol.
            CopyMemory TempUC_ExForm, HookParam.pUsercontrol, LenB(HookParam.pUsercontrol)

            'Debug.Print wMsg, wParam, lParam

            'This way we are able to run a public/friend procedure from within this module.
            TempUC_ExForm.Deactivated lParam, Cancel

            'Deactivate tempvariable.
            CopyMemory TempUC_ExForm, 0&, LenB(HookParam.pUsercontrol)
            Set TempUC_ExForm = Nothing

            If Cancel = False And lParam <> HookParam.ChildhWnd Then

                'Hide the child window
                PostMessage HookParam.ChildhWnd, WM_SHOWWINDOW, 0, SW_PARENTOPENING

                'Unhook all windows.
                ExFrm_UnHook HookParam

                'Redraw border of parent active or inactive.
                PostMessage hWndParent, WM_ACTIVATE, Abs(lParam = hWndParent), 0

                'Actual redraw.
                SetWindowPos hWndParent, hWndParent, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOZORDER Or SWP_FRAMECHANGED
                Exit Function

            End If

        End If

    End Select

    If PrevProc = 0 Then Exit Function

    ExFrm_WndProc = CallWindowProc(PrevProc, hwnd, wMsg, wParam, lParam)

End Function
