我有一个键盘钩子，可以监听 [shift] + [F12] 按键按下以激活程序中的编辑模式。通过编辑模式，我的意思是禁用程序窗口中不活动的任何表单，并将焦点设置为活动窗口。此外，我更改了 GUI 以反映用户正在运行编辑模式。
这一切的目的是定制用户单击的特定表单控件（例如，如果他们单击标签或组合框，用户将能够编辑从数据库填充此信息的数据）。我真正要寻找的是能够访问用户在活动表单中单击的控件的控件名称，DYNAMICALLY（无需在每个表单上设置事件）。因此，一旦用户单击控件，例如标签、组合框、列表视图或列表框（在活动窗体上），我想捕获单击的控件名称并将其传递给另一个将处理该控件编辑的窗体.
您无需费心使用 API 来做您想做的事。您提到的所有控件都公开了一个 Click 事件。（如果您要使用的控件没有 Click 事件，它几乎肯定有一个 MouseDown 事件，它也可以正常工作。）只需编写一个将控件作为参数并将您想要的信息传递给其他形式。然后在每个控件中（您可以将控件数组用于相同类型的控件），调用此子。像这样的东西：
Sub DoTheWork(cCtl As Control)
Form2.CallSomeMethod(cCtl) 'Passes a reference to the entire control
Form2.CallSomeOtherMethod(cCtl.Name) 'Just passes the name
End Sub
Sub Command1_Click()
DoTheWork Command1
End Sub
Sub Label1_Click(Index As Integer) 'control array
DoTheWork Label1(Index)
End Sub
现在，如果你真的想参与使用 SetWindowsHookEx 和所有这些，这里有一些带注释的代码，你可以用它来弄清楚。此代码允许您更改 MsgBox 函数上的字体，方法是将其自身替换为任何 MsgBox 调用。（仅供参考，微软当时实施了“CBT 挂钩”来支持基于计算机的培训，因此有这个术语。）
'This code allows font changes and various other format customizations of the standard VB6 MsgBox dialog box. It
'uses CBT hooking to intercept an VB6-internal window call. In this case, it intercepts a MsgBox call, then gets
'a handle to the MsgBox window as well as its various child windows (the label containing the message text, any
'buttons, and an icon if it exists). It then resizes the window to accommodate the message text and other windows,
'and repositions the icon and any command buttons. Finally, it positions the msgbox window in the center of the
'screen.
'General Note: notes are above the line of code to which they apply.
Option Explicit
' Window size and position constants
Private Const ICON_WIDTH As Integer = 32
Private Const BTN_WIDTH As Integer = 75
Private Const BTN_HEIGHT As Integer = 23
Private Const BTN_SPACER As Integer = 6 ' Space between 2 buttons
Private Const STW_OFFSET As Integer = 12 ' Standard window offset, minimum distance one window can be from
' the edge of its container
' SendMessage constants that we will use
Private Const WM_SETFONT = &H30
Private Const WM_GETTEXT = &HD
' Necessary constants for CBT hooking
Private Const HCBT_CREATEWND = 3
Private Const HCBT_ACTIVATE = 5
Private Const WH_CBT = 5
' Working variables that require module-wide scope
Private hHook As Long
Private myFont As IFont
Private cPrompt As String
Private hwndStatic As Long
Private ButtonHandles() As Long
Private xPixels As Long
Private yPixels As Long
Private isIcon As Boolean
' The API Type declarations we need
Private Type SIZE
cx As Long
cy As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
'GETTEXT needs a String argument for lParam, SETFONT needs an Any argument there, hence 2 declarations for SendMessageA
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
Private Declare Function SendMessageS Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
' Wrapper for the normal MsgBox function
Public Function myMsgBox(Prompt As String, Buttons As VbMsgBoxStyle, ByVal fSize As Integer, ByVal fBold As Boolean, ByVal fItalic As Boolean, ByVal fULine As Boolean, fFaceName As String, Optional Title As String, Optional HelpFile As String, Optional Context As Long, Optional x As Long, Optional y As Long) As Long
'x and y arguments are optional and are in twips. If not specified, msgbox will use default window sizes
'and positions, which work fine if you are using default font sizes. If you aren't they may not.
cPrompt = Prompt
Set myFont = New StdFont
With myFont ' We can make whatever adjustments we like here to the font
.SIZE = fSize
.Bold = fBold
.Italic = fItalic
.Underline = fULine
.Name = fFaceName
End With
'Convert x and y arguments to pixels from twips. (Twips are the same size no matter what the screen resolution; pixels aren't.)
If Not IsMissing(x) Then
xPixels = Int(x / Screen.TwipsPerPixelX)
End If
If Not IsMissing(y) Then
yPixels = Int(y / Screen.TwipsPerPixelY)
End If
'Set up the hook to catch windows messages, call CBTProc when there is one
hHook = SetWindowsHookEx(WH_CBT, AddressOf CBTProc, App.hInstance, 0)
'This will call CBTProc, passing the handle of the MsgBox window to the wParam argument.
myMsgBox = MsgBox(Prompt, Buttons, Title, HelpFile, Context)
End Function
Private Function CBTProc(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim i As Integer
Dim statX As Integer 'X dimension of static (text) window
Dim statY As Integer 'Y dimension of same
Dim cLeft As Integer 'Current Left value for current button, used to position buttons along x axis
Dim rc As RECT 'Used with GetClientRect
If lMsg = HCBT_ACTIVATE Then
'Immediately unhook (we have the event we're looking for, and don't want to handle any more CBT events)
UnhookWindowsHookEx hHook
'Call EnumChildWindowProc once for each window that is contained in the MsgBox (each button and frame is a child window)
EnumChildWindows wParam, AddressOf EnumChildWindowProc, 0
'Reinitialize the static buttoncount variable, see the notes in the proc
EnumChildWindowProc 0, 1
'Should always be true, but this prevents an abend if for some reason we fail to get the text window
If hwndStatic Then
'If the x parameter has been supplied to the main wrapper, then xPixels <> 0
If xPixels <> 0 Then
With Screen
'Center the MsgBox window in the screen
SetWindowPos wParam, 0, (.Width / .TwipsPerPixelX - xPixels) / 2, _
(.Height / .TwipsPerPixelY - yPixels) / 2, xPixels, yPixels, 0
End With
'Analogous to the ScaleWidth and ScaleHeight properties. Client rectangle's dimensions are
'returned to the rc type and exclude the dimensions of the title bar and the borders.
GetClientRect wParam, rc
'Calculate x and y values for text window. If there's an icon, we need to reduce the size of the
'text window by the width of the icon plus a standard offset value.
statX = rc.Right - rc.Left - STW_OFFSET * 2 - ((isIcon And 1) * (ICON_WIDTH + STW_OFFSET))
statY = rc.Bottom - rc.Top - BTN_HEIGHT - STW_OFFSET * 2
'We need to position the text window along the x axis such that it's a standard offset from the left
'border of the msgbox, plus the width of the icon and another standard offset if the icon exists.
SetWindowPos hwndStatic, 0, STW_OFFSET + (isIcon And 1) * (ICON_WIDTH + STW_OFFSET), STW_OFFSET, statX, statY, 0
isIcon = 0
'Loop through the button handles, calculating the left border position each time.
For i = 0 To UBound(ButtonHandles)
'Current left border is half the container window's width, less the width of half the total
'number of buttons, plus the offset of the current button in the array.
cLeft = Int(xPixels / 2 + BTN_WIDTH * (i - (UBound(ButtonHandles) + 1) / 2))
'Modify the above to add button spacer widths.
cLeft = cLeft + BTN_SPACER * (i - (UBound(ButtonHandles) - 1) + (UBound(ButtonHandles) Mod 2) / 2)
'The Y value is 1 standard offset more than the height of the text window.
SetWindowPos ButtonHandles(i), 0, cLeft, statY + STW_OFFSET, BTN_WIDTH, BTN_HEIGHT, 0
Next
End If
SendMessage hwndStatic, WM_SETFONT, myFont.hFont, True
End If
End If
CBTProc = 0 ' allow operation to continue
End Function
Private Function EnumChildWindowProc(ByVal hChild As Long, ByVal lParam As Long) As Long
Static ButtonCount As Integer
Dim sLen As Integer
Dim wClass As String
Dim wText As String
Dim rc As RECT
If lParam Then
ButtonCount = 0 'See the direct call of this proc in CBTProc: resets the ButtonCount variable to 0
Exit Function
End If
wClass = String(64, 0)
'look up the type of the current window
sLen = GetClassName(hChild, wClass, 63)
wClass = Left(wClass, sLen)
'We have either one or two static windows: optionally the icon (the first window if it's there) and the
'text window (analogous to a label control).
If wClass = "Static" Then
'If we already have the text window's handle, we don't need to do this anymore.
If Not hwndStatic Then
'Find out if the current window's text value is the same as the text passed in to the cPrompt
'argument in the main wrapper function. If it is, it's the text window and we store the handle
'value in hwndStatic. If it isn't, then it's an icon and we set the isIcon flag.
wText = String(Len(cPrompt) + 1, 0)
sLen = SendMessageS(hChild, WM_GETTEXT, 255, wText)
wText = Left(wText, sLen)
If wText = cPrompt Then
hwndStatic = hChild
Else
isIcon = True
End If
End If
ElseIf wClass = "Button" Then
'Store the button's handle in the ButtonHandles array
ReDim Preserve ButtonHandles(ButtonCount)
ButtonHandles(ButtonCount) = hChild
ButtonCount = ButtonCount + 1
End If
EnumChildWindowProc = 1 ' Continue enumeration
End Function