1,485
社区成员
发帖
与我相关
我的任务
分享
Option Explicit
'设置透明窗体
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 SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Const WS_EX_LAYERED = &H80000
Const GWL_EXSTYLE = (-20)
Const LWA_ALPHA = &H2
Const LWA_COLORKEY = &H1
Dim sty As Long
sty = GetWindowLong(Me.hwnd, GWL_EXSTYLE)
sty = sty Or WS_EX_LAYERED
SetWindowLong Me.hwnd, GWL_EXSTYLE, sty
SetLayeredWindowAttributes Me.hwnd, 0, 200, LWA_ALPHA
Option Explicit
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
'hwnd ----------- Long,欲为其取得信息的窗口的句柄
'nIndex --------- Long,请参考GetWindowLong函数的nIndex参数的说明
'dwNewLong ------ Long,由nIndex指定的窗口信息的新值
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
'hwnd ----------- Long,欲为其获取信息的窗口的句柄
'nIndex --------- Long,欲取回的信息,可以是下述任何一个常数:
'GWL_EXSTYLE
'扩展窗口样式
'GWL_STYLE
'窗口样式
'GWL_WNDPROC
'该窗口的窗口函数的地址
'GWL_HINSTANCE
'拥有窗口的实例的句柄
'GWL_HWNDPARENT
'该窗口之父的句柄?不要用SetWindowWord来改变这个值
'GWL_ID
'对话框中一个子窗口的标识符
'GWL_USERDATA
'含义由应用程序规定
'DWL_DLGPROC
'这个窗口的对话框函数地址
'DWL_MSGRESULT
'在对话框函数中处理的一条消息返回的值
'DWL_USER
'含义由应用程序规定
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
'hwnd --透明窗体的句柄
'crKey --为颜色值
'bAlpha -- 透明度,取值范围是[0,255]
'dwFlags -- 透明方式,可以取两个值:当取值为LWA_ALPHA时,crKey参数无效,
'bAlpha参数有效;当取值为LWA_COLORKEY时,bAlpha参数有效而窗体中的所有颜色为crKey的地方将变为透明
Const WS_EX_LAYERED = &H80000
Const GWL_EXSTYLE = (-20) '窗体扩展式样
Const LWA_COLORKEY = &H1 '关键颜色(异形窗体)
Const LWA_ALPHA = &H2 '透明度
Const LWA_COLORKEY_ALPHA = &H3 '透明 + 异形
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Const HTCAPTION = 2
Const WM_NCLBUTTONDOWN = &HA1
Private Sub Command1_Click()
End
End Sub
Private Sub Form_Load()
Dim NewStyle As Long '窗体的新式样
Dim WinStyle As Long '记录窗体原来的式样
WinStyle = GetWindowLong(Me.hwnd, GWL_EXSTYLE) '获得窗体的扩展式样
NewStyle = WinStyle + WS_EX_LAYERED '窗体新式样
SetWindowLong Me.hwnd, GWL_EXSTYLE, NewStyle '付值给窗体新的式样
SetLayeredWindowAttributes Me.hwnd, RGB(255, 0, 0), 200, LWA_COLORKEY_ALPHA '异形+半透明
' SetLayeredWindowAttributes Me.hwnd, 0, 128, LWA_ALPHA '半透明
' SetLayeredWindowAttributes Me.hwnd, RGB(255, 0, 0), 0, LWA_COLORKEY '异形
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
Call ReleaseCapture
Call SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
End If
End Sub