VBA Excel 引用 API，以实现“透明”

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

 

 

 

转载于:https://www.cnblogs.com/ssfie/p/3801046.html