子窗体永显示在最底层,其它子窗体时打开时显示在该窗体的上层

 

在模块中添加

Option Explicit

'怎样让MDI子窗体永显示在最底层,其它子窗体时打开时显示在该窗体的上层,
'即使用鼠标点击它也让它显示在最底层.

Private Const WM_WINDOWPOSCHANGED = &H47
Private Const WM_WINDOWPOSCHANGING = &H46
Private Type WINDOWPOS
                hwnd   As Long
                hWndInsertAfter   As Long
                x   As Long
                y   As Long
                cx   As Long
                cy   As Long
                flags   As Long
End Type
Private Const SWP_NOZORDER = &H4
Private Const HWND_BOTTOM = 1&
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Const GWL_WNDPROC = (-4&)
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private 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
Private Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Const PROP_OLDPROC = "MdiChildOnBottom_OldWndProc "
Private Declare Function DefWindowProc Lib "user32 " Alias "DefWindowProcA " (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Public Sub MdiChildOnBottomSet(ByVal hwnd As Long)
    Dim oProc     As Long
    oProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf MdiChildOnBottomWndProc)
    If oProc Then
        SetProp hwnd, PROP_OLDPROC, oProc
    End If
End Sub

Public Sub MdiChildOnBottomReset(ByVal hwnd As Long)
    Dim lpProc As Long
    lpProc = GetProp(hwnd, PROP_OLDPROC)
    If lpProc Then
        SetWindowLong hwnd, GWL_WNDPROC, lpProc
    End If
    RemoveProp hwnd, PROP_OLDPROC
End Sub

Private Function MdiChildOnBottomWndProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim wpos  As WINDOWPOS, oProc As Long
    Select Case uMsg
    Case WM_WINDOWPOSCHANGING
        CopyMemory wpos, ByVal lParam, LenB(wpos)
        wpos.hWndInsertAfter = HWND_BOTTOM
        wpos.flags = wpos.flags And (Not SWP_NOZORDER)
        CopyMemory ByVal lParam, wpos, LenB(wpos)
    End Select
    oProc = GetProp(hwnd, PROP_OLDPROC)
    If oProc Then
        MdiChildOnBottomWndProc = CallWindowProc(oProc, hwnd, uMsg, wParam, lParam)
    Else
        MdiChildOnBottomWndProc = DefWindowProc(hwnd, uMsg, wParam, lParam)
    End If
End Function

在子窗体的Form_load事件添加

MdiChildOnBottomSet Me.hwnd

 

                                                                                                                                                                                      转载至：何庆刚