Question

我有一个键盘挂钩，可以在我的程序中按[shift] + [F12]键按钮激活编辑模式。通过编辑模式，我的意思是禁用在程序窗口中处于非活动状态的任何表单，并将焦点设置为活动窗口。此外，我更改了GUI以反映用户正在运行编辑模式。

这一切的目的是自定义用户点击的特定表单控件（例如，如果他们单击标签或组合框，则用户将能够编辑从数据库填充此信息的数据）。我真正寻找的是能够访问用户在活动表单中单击的控件的控件名称，动态（不在每个表单上设置事件）。因此，一旦用户点击控件（如标签，组合框，列表视图或列表框（在活动表单上）），我想捕获单击的控件名称并将其传递给另一个将处理此控件编辑的表单。

Answer 1

您无需为使用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

VB6鼠标钩子捕获用户点击的控件

1 个答案: