怎么实现“鼠标穿透”,即鼠标对窗体失去作用,对着它点右键要出现WINDOWS的桌面右菜单

来源:互联网 发布:淘宝发货能改地址吗 编辑:程序博客网 时间:2024/03/29 18:12

Const LWA_COLORKEY = &H1
Const LWA_ALPHA = &H2
Const GWL_EXSTYLE = (-20)
Const WS_EX_LAYERED = &H80000
Const WS_EX_TRANSPARENT   As Long = &H20&
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 Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Sub Form_Load()
 
       Dim Ret   As Long
       Ret = GetWindowLong(Me.hWnd, GWL_EXSTYLE)
'你再加上WS_EX_TRANSPARENT就能穿透鼠标了
       Ret = Ret Or WS_EX_LAYERED Or WS_EX_TRANSPARENT
       SetWindowLong Me.hWnd, GWL_EXSTYLE, Ret
       'Set  the  opacity  of  the  layered  window  to  200
       SetLayeredWindowAttributes Me.hWnd, 0, 50, LWA_ALPHA
End Sub

根本就不需要 在右键事件里把消息转发给桌面句柄
Public Sub SetFormTran(ByVal Obj As form, ByVal Tran As Long)
On Error GoTo ErrTran
    SetWindowLong Obj.Hwnd, GWL_EXSTYLE, GetWindowLong(Obj.Hwnd, GWL_EXSTYLE) Or WS_EX_LAYERED Or WS_EX_TRANSPARENT
    SetLayeredWindowAttributes Obj.Hwnd, 0, Tran, LWA_ALPHA Or LWA_COLORKEY
Obj.Refresh
ErrTran:
End Sub

private sub command1_click
SetFormTran form1,100
end sub

 
原创粉丝点击