VBA Fans

' API函数
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
        ByVal lpClassName As String, _
        ByVal lpWindowName As String) As Long
Public Declare Function ShowWindow Lib "user32" ( _
        ByVal hwnd As Long, _
        ByVal nCmdShow 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 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 Function SetLayeredWindowAttributes Lib "user32" ( _
        ByVal hwnd As Long, _
        ByVal crKey As Long, _
        ByVal bAlpha As Byte, _
        ByVal dwFlags As Long) As Long
Public Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetMenuItemCount Lib "user32" (ByVal hmenu As Long) As Long
Public Declare Function RemoveMenu Lib "user32" ( _
        ByVal hmenu As Long, _
        ByVal nPosition As Long, _
        ByVal wFlags As Long) As Long
Public Declare Function DeleteMenu Lib "user32" ( _
        ByVal hmenu As Long, _
        ByVal nPosition As Long, _
        ByVal wFlags As Long) As Long
Public Declare Function GetSystemMenu Lib "user32" ( _
        ByVal hwnd As Long, _
        ByVal bRevert As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
        ByVal hwnd As Long, _
        ByVal wMsg As Long, _
        ByVal wParam As Long, _
        lParam As Any) As Long
Public Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Public Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Public Declare Function AnimateWindow Lib "user32" ( _
        ByVal hwnd As Long, _
        ByVal dwTime As Long, _
        ByVal dwFlags As Long) As Long
Public Declare Function MoveWindow Lib "user32" ( _
        ByVal hwnd As Long, _
        ByVal x As Long, _
        ByVal y As Long, _
        ByVal nWidth As Long, _
        ByVal nHeight As Long, _
        ByVal bRepaint As Long) As Long
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
 
' API常量
Public Const GWL_STYLE = (-16)
Public Const GWL_EXSTYLE = (-20)
 
 
Public Const WS_MAXIMIZEBOX = &H10000
Public Const WS_MINIMIZEBOX = &H20000
Public Const WS_THICKFRAME = &H40000
Public Const WS_EX_LAYERED = &H80000
Public Const WS_SYSMENU = &H80000
Public Const WS_CAPTION = &HC00000
 
Public Const SW_HIDE = 0
Public Const SW_SHOWNORMAL = 1
Public Const SW_SHOWMINIMIZED = 2
Public Const SW_SHOWMAXIMIZED = 3
 
Public Const LWA_ALPHA = &H2
 
Public Const MF_BYCOMMAND = &H0
Public Const MF_BYPOSITION = &H400&
Public Const MF_DISABLED = &H2&
Public Const MF_REMOVE = &H1000&
 
Public Const SC_CLOSE = &HF060
Public Const SC_MOVE = &HF010
 
Public Const WM_SYSCOMMAND = &H112
 
Public Const AW_ACTIVATE = &H20000
Public Const AW_BLEND = &H80000
 
Public Enum ESetWindowPosStyles
    SWP_SHOWWINDOW = &H40
    SWP_HIDEWINDOW = &H80
    SWP_FRAMECHANGED = &H20
    SWP_NOACTIVATE = &H10
    SWP_NOCOPYBITS = &H100
    SWP_NOMOVE = &H2
    SWP_NOOWNERZORDER = &H200
    SWP_NOREDRAW = &H8
    SWP_NOREPOSITION = SWP_NOOWNERZORDER
    SWP_NOSIZE = &H1
    SWP_NOZORDER = &H4
    SWP_DRAWFRAME = SWP_FRAMECHANGED
    HWND_TOPMOST = -1
    HWND_NOTOPMOST = -2
End Enum
 
Public Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

' 窗口句柄变量
Dim hwnd As Long
Private Sub cmdMax_Click()
    ShowWindow hwnd, SW_SHOWMAXIMIZED
End Sub
Private Sub cmdMin_Click()
    ShowWindow hwnd, SW_SHOWMINIMIZED
End Sub
Private Sub cmdNormal_Click()
    ShowWindow hwnd, SW_SHOWNORMAL
End Sub
 
Private Sub cmdShow_Click()
    Dim lStyle As Long
    If Left(cmdShow.Caption, 2) = "关闭" Then
        lStyle = GetWindowLong(hwnd, GWL_STYLE)
        lStyle = lStyle And Not WS_THICKFRAME
        lStyle = lStyle And Not WS_MINIMIZEBOX
        lStyle = lStyle And Not WS_MAXIMIZEBOX
        cmdShow.Caption = "显示最大化最小化按钮"
        cmdMin.Enabled = False
    Else
        lStyle = GetWindowLong(hwnd, GWL_STYLE)
        lStyle = lStyle Or WS_THICKFRAME
        lStyle = lStyle Or WS_MINIMIZEBOX
        lStyle = lStyle Or WS_MAXIMIZEBOX
        cmdShow.Caption = "关闭最大化最小化按钮"
        cmdMin.Enabled = True
    End If
    SetWindowLong hwnd, GWL_STYLE, lStyle
    Application.ScreenUpdating = False
    Me.Hide
    Me.Show
    Application.ScreenUpdating = True
End Sub
' 显示窗体最大化、最小化按钮并使窗体边框可拉
Private Sub UserForm_Initialize()
    Dim lStyle As Long
    ' 获取窗体句柄
    hwnd = FindWindow(vbNullString, Me.Caption)
    ' 获取窗体风格
    lStyle = GetWindowLong(hwnd, GWL_STYLE)
    lStyle = lStyle Or WS_THICKFRAME    ' 可拉动边框
    lStyle = lStyle Or WS_MINIMIZEBOX   ' 最小化按钮
    lStyle = lStyle Or WS_MAXIMIZEBOX   ' 最大化按钮
    ' 设置窗体风格
    SetWindowLong hwnd, GWL_STYLE, lStyle
End Sub