Please enable Javascript to view the contents

VB6_按钮单击消息处理

 ·  ☕ 2 分钟  ·  🤣 lin

模块代码:

Option Explicit
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Public Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Public lpPrevWndProc As Long
Public 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
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''    - By 风陵 - InkHin.com {你你你!居然夹带私货!}  - '''''''''''
        '''''''''''''    供广大人民群众研究学习使用 随便抄   '''''''''''''''''

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Command() As Long  '按钮组

Public Function 获取控件名(ByRef YourControls As Object, Find As Long) As String
Dim kj As Control
For Each kj In YourControls
On Error Resume Next
    If kj.hwnd = Find Then
        获取控件名 = kj.Name
'非数组控件类型读取该项属性会报错非数组 emm暂时也没有想到更好的方法只能加个错误处理了
        获取控件名 = 获取控件名 & kj.Index
        Exit For
    End If
Next
End Function
Public Sub 数组_获取窗体所有按钮(ByVal hwnd As Long, ByRef Value() As Long)
Dim start As Long
start = GetWindow(GetWindow(hwnd, 5), 0)
Dim Now As Long '实时句柄
Dim s As String 'IpClassName
 'Dim Value() as Long '储存按钮句柄
Now = start
Dim i As Integer
Do While Now <> 0 '遍历控件
    s = String(256, Chr(0)): GetClassName Now, s, 255
    s = Replace(s, Chr(0), "")
    '处理代码
    If s = "ThunderCommandButton" Then
                ReDim Preserve Value(i)
                Value(i) = Now
                i = i + 1
    End If
    数组_获取窗体所有按钮 Now, Value()
    Now = GetWindow(Now, 2)
    If Now = start Then Exit Do
Loop
End Sub
'消息处理
Public Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 If uMsg = &H201 And wParam = &H1 Then
    Debug.Print "控件:" + 获取控件名(Form1.Controls, hw) + " 被左键单击"
 End If

 WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
End Function

窗体代码:

Private Sub Form_Load()
Call 数组_获取窗体所有按钮(Me.hwnd, Command())
Init
End Sub

Private Sub Init()
Dim i As Integer
For i = 0 To UBound(Command())
   lpPrevWndProc = SetWindowLong(Command(i), -4, AddressOf WindowProc)
Next
End Sub

使用效果:

分享

风陵
作者
lin
A Student | Java Dev