如何处理更多事件Visual Basic 6.0不支持

本文介绍如何在Visual Basic 6.0中通过自定义窗口过程处理更多事件,如鼠标滚轮和悬停事件,这在运行时动态创建UI控件时特别有用。文章详细解释了使用API函数修改窗口过程的步骤。

嗨,大家好...

使用此Visual Basic 6.0代码,您可以处理更多的事件,如Visual Basic支持作为鼠标滚轮和悬停,或者可以在Windows开始创建时在VB IDE默认Windows proc之前将事件控制为WM_CREATE,例如,对于某些应用程序,此任务很有用在运行时使用Form1.Control.add(“ vb.CommandButton”,“ Cmd1”)函数创建新的UI控件,然后可以通过WM_COMMAND消息和命令ID处理命令按钮事件

Module1.bas

Option Explicit 
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 CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Sub CopyPtrToObj Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Object, ByRef Source As Long, Optional ByVal Length As Long = 4)
Private Declare Sub CopyObjToPtr Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Long, ByRef Source As Object, Optional ByVal Length As Long = 4)  
Private Const GWL_USERDATA = (-21)
Private Const GWL_WNDPROC = (-4)  
Private Const WM_MOUSEWHEEL As Long = &H20A
Private Const WM_MOUSEHOVER As Long = &H21A 
Public Sub ChangeWindowProc(ByVal WindowObject As Object)
Dim LastFormProc As Long
Dim WindowObjectPointer As Long
    'Get Proc Address assigned by VB IDE
    LastFormProc = GetWindowLong(WindowObject.hwnd, GWL_WNDPROC)
    Call CopyObjToPtr(WindowObjectPointer, WindowObject)        'Copy Object memory Pointer to Long variable
    WindowObject.Tag = LastFormProc                             'hold lastProc in tag property u can create public variable in each window and assign this value to it and use tag for ur work
    'Save Last Window Object Pointer in Window Class User Extedned Data,now u can change proc for multiple form at one time
    'sure user cant active 2 forms in same time, but because of timer event and winsock
    Call SetWindowLong(WindowObject.hwnd, GWL_USERDATA, WindowObjectPointer)
    'change VB IDE proc by new our Proc Address
    Call SetWindowLong(WindowObject.hwnd, GWL_WNDPROC, AddressOf WindowExtendedEventProc)
End Sub 
'Reset Window Proc To Orignal VB IDE Proc.
Public Sub ResetWindowProc(ByVal WindowObject As Object)
Dim LastFormProc As Long
    LastFormProc = Val(WindowObject.Tag)
    Call SetWindowLong(WindowObject.hwnd, GWL_USERDATA, LastFormProc)
End Sub 
'Our New Window Defined proc
Public Function WindowExtendedEventProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'this variable is static because visual basic will unallocate all objects and variables within function after excution complete
'try to change it to Dim FormObject as object your application will crash
Static FormObject As Object
Dim LastFormProc As Long
Dim FormObjectPointer As Long
    'get Object Pointer Again in long var
    FormObjectPointer = GetWindowLong(hwnd, GWL_USERDATA)
    Call CopyPtrToObj(FormObject, FormObjectPointer)    'this line seems as "Set FormObject=Form1" !!!!
    LastFormProc = Val(FormObject.Tag)                  'retrieve LastProc Address From tag
    Select Case Msg
        Case WM_MOUSEWHEEL                  'if user Roll Mouse Wheel
            Call FormObject.Form_MouseWheel
            WindowExtendedEventProc = 0
            Exit Function
        Case WM_MOUSEHOVER
            Call FormObject.Form_MouseWheel
            WindowExtendedEventProc = 0
            Exit Function
    End Select
    'call orignal VB IDE Proc with other windows messages
    WindowExtendedEventProc = CallWindowProc(LastFormProc, hwnd, Msg, wParam, lParam)
End Function
'================================================= =======

Form1.frm

Option Explicit 
Private Sub Form_Activate()
   Call ChangeWindowProc(Me)
End Sub 
Private Sub Form_Deactivate()
   Call ResetWindowProc(Me)
End Sub 
Public Sub Form_MouseWheel()
    MsgBox "mouse Wheel"
End Sub 
Public Sub Form_MouseHover()
    MsgBox "mouse Wheel"
End Sub
祝好运

From: https://bytes.com/topic/visual-basic/insights/737331-how-handle-more-events-visual-basic-6-0-not-support

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值