洛阳翼展电脑

置顶窗口测试OK

2025-2-14 乱云飞

' 在模块中声明 API 函数和常量
Option Explicit

Private 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 uFlags As Long) As Long

Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
    ByVal hwnd As Long, ByVal nIndex As Long) As Long

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
    ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Const GWL_EXSTYLE As Long = -20
Private Const WS_EX_TOPMOST As Long = &H8
Private Const SWP_NOMOVE As Long = &H2
Private Const SWP_NOSIZE As Long = &H1
Private Const SWP_SHOWWINDOW As Long = &H40
Private Const HWND_TOPMOST As Long = -1
Private Const HWND_NOTOPMOST As Long = -2


Private Sub Form_Load()
    ' 调用函数设置窗体置顶
    SetFormTopMost Me.hwnd, True
End Sub

' 声明一个公共子程序来设置窗体的置顶状态
Public Sub SetFormTopMost(ByVal hwnd As Long, ByVal TopMost As Boolean)
    Dim lStyle As Long
    ' 获取当前窗口扩展样式
    lStyle = GetWindowLong(hwnd, GWL_EXSTYLE)
    
    ' 根据 TopMost 参数设置或清除 WS_EX_TOPMOST 标志
    If TopMost Then
        lStyle = lStyle Or WS_EX_TOPMOST
    Else
        lStyle = lStyle And Not WS_EX_TOPMOST
    End If
    
    ' 设置新的窗口扩展样式
    SetWindowLong hwnd, GWL_EXSTYLE, lStyle
    
    ' 通过 SetWindowPos 刷新窗口的 Z 顺序，确保置顶状态生效
    ' 注意：这里我们不改变窗口的位置和大小，只刷新 Z 顺序
    SetWindowPos hwnd, IIf(TopMost, HWND_TOPMOST, HWND_NOTOPMOST), 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_SHOWWINDOW
End Sub