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

    技术2022-05-11  129

    Const LWA_COLORKEY = &H1Const LWA_ALPHA = &H2Const GWL_EXSTYLE = (-20)Const WS_EX_LAYERED = &H80000Const WS_EX_TRANSPARENT   As Long = &H20&Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As LongPrivate Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPrivate Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As LongPrivate 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_ALPHAEnd 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_COLORKEYObj.RefreshErrTran:End Sub

    private sub command1_clickSetFormTran form1,100end sub


    最新回复(0)