1. 引用 API 函数
' 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
Const SM_CXSCREEN = 0 'Width of screen
Const SM_CYSCREEN = 1 'Height of screen
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
'API判断数组为空或没有初始化
Public Declare Function SafeArrayGetDim Lib "oleaut32.dll" (ByRef saArray() As Any) As Long
2. 窗体 中……
2.1 定义全局变量
Dim hwnd As Long
Dim lStyleOld As Long
2.2 '窗体是否透明？
Me.ToggleButton1 = Sheets("setting").Range("C17")
hwnd = FindWindow(vbNullString, Me.Caption)
ToggleButton1_Click
Private Sub ToggleButton1_Click()
Dim rtn As Long
Dim touming As Integer
touming = Sheets("setting").Range("C16")
' 保存旧的窗体风格
lStyleOld = GetWindowLong(hwnd, GWL_EXSTYLE)
rtn = lStyleOld Or WS_EX_LAYERED
SetWindowLong hwnd, GWL_EXSTYLE, rtn
If Me.ToggleButton1.Value = True Then
SetLayeredWindowAttributes hwnd, 0, touming, LWA_ALPHA
Else
SetLayeredWindowAttributes hwnd, 0, 255, LWA_ALPHA
End If
End Sub