如何创建一个命令按钮来告诉我哪个控件具有 FOCUS？

Question

我在我的 VB6 表单上放置了一个命令按钮。我想这样做，如果我单击此按钮，它将弹出一条消息，指示最近哪个控件具有 FOCUS。

我知道如果我按下命令按钮，它将导致命令按钮获得焦点。我有兴趣在命令按钮将焦点移开之前找出哪个控件具有焦点。我该怎么做？

Answer 1

Subclass 按钮。
处理WM_SETFOCUS.
采取相应的行动。

示例。

表格Form1：

Option Explicit

Private Sub cmdCleverButton_Click()
  MsgBox cmdCleverButton.Tag
End Sub

Private Sub Form_Load()
  modCleverButtonSublass.SubclassCleverButton cmdCleverButton, Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
  modCleverButtonSublass.UnsubclassCleverButton
End Sub

模块 modCleverButtonSublass

Option Explicit

Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32.dll" 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 Const GWL_WNDPROC As Long = -4&
Private Const WM_SETFOCUS As Long = &H7&


Private m_PrevWndProc As Long
Private m_Button As CommandButton
Private m_Form As Form


Public Sub SubclassCleverButton(ByVal b As CommandButton, ByVal ParentForm As Form)
  If Not m_Button Is Nothing Then Err.Raise 5, , "Already subslassed."

  Set m_Button = b
  Set m_Form = ParentForm
  m_PrevWndProc = SetWindowLong(m_Button.hwnd, GWL_WNDPROC, AddressOf SubclassCallback)
End Sub

Public Sub UnsubclassCleverButton()
  If m_Button Is Nothing Then Err.Raise 5, , "Subclass first."

  SetWindowLong m_Button.hwnd, GWL_WNDPROC, m_PrevWndProc
  Set m_Form = Nothing
  Set m_Button = Nothing
End Sub


Private Function SubclassCallback(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  If uMsg = WM_SETFOCUS Then
    Dim c As Control

    Set c = FindByHwnd(m_Form, wParam)
    If c Is Nothing Then
      m_Button.Tag = vbNullString
    Else
      m_Button.Tag = c.Name
    End If
  End If

  SubclassCallback = CallWindowProc(m_PrevWndProc, hwnd, uMsg, wParam, lParam)
End Function

Private Function FindByHwnd(ByVal Parent As Form, ByVal hwnd As Long) As Control
  Dim c As Control

  For Each c In Parent.Controls
    If c.hwnd = hwnd Then
      Set FindByHwnd = c
      Exit Function
    End If
  Next
End Function

Answer 2

Private lastControl As Control
Private lastFocus As Control

Private Sub Timer1_Timer()

Dim curControl As Control
Set curControl = Screen.ActiveControl

If lastControl Is Nothing Then
    Set lastControl = curControl
End If

If curControl.Name <> lastControl.Name Then 
    Set lastFocus = lastControl  'this line memorizes which control most recently just had FOCUS
    Set lastControl = curControl
End If

End Sub

Answer 3

你需要一个简单的辅助焦点转发类来完成它，而不需要像这样的子类（不完整的示例类）

' cFocusFwd    
Option Explicit

Private WithEvents m_oCommand   As VB.CommandButton
Private WithEvents m_oCombo     As VB.ComboBox
Private WithEvents m_oText      As VB.TextBox
Private WithEvents m_oCheck     As VB.CheckBox
Private WithEvents m_oOption    As VB.OptionButton
Private WithEvents m_oExt       As VB.VBControlExtender
Private m_oForm                 As Object

Friend Function frInit(oCtl As Object, oForm As Object) As Boolean
    If TypeOf oCtl Is VB.CommandButton Then
        Set m_oCommand = oCtl
    ElseIf TypeOf oCtl Is VB.ComboBox Then
        Set m_oCombo = oCtl
    ElseIf TypeOf oCtl Is VB.TextBox Then
        Set m_oText = oCtl
    ElseIf TypeOf oCtl Is VB.CheckBox Then
        Set m_oCheck = oCtl
    ElseIf TypeOf oCtl Is VB.OptionButton Then
        Set m_oOption = oCtl
    ElseIf TypeOf oCtl Is VB.VBControlExtender Then
        Set m_oExt = oCtl
    Else
        Exit Function
    End If
    Set m_oForm = oForm
    '--- success
    frInit = True
End Function

Private Sub m_oCommand_GotFocus()
    m_oForm.ControlGotFocus m_oCommand
End Sub

Private Sub m_oCombo_GotFocus()
    m_oForm.ControlGotFocus m_oCombo
End Sub

Private Sub m_oText_GotFocus()
    m_oForm.ControlGotFocus m_oText
End Sub

Private Sub m_oCheck_GotFocus()
    m_oForm.ControlGotFocus m_oCheck
End Sub

Private Sub m_oOption_GotFocus()
    m_oForm.ControlGotFocus m_oOption
End Sub

Private Sub m_oExt_GotFocus()
    m_oForm.ControlGotFocus m_oExt
End Sub

然后在您的表单中使用它来接收通知ControlGotFocus 回调子控件获得这样的焦点

Option Explicit

Private m_oLastFocused      As Object
Private m_cFocusFwds        As Collection

' this is called from cFocusFwd when control gets focus
Public Sub ControlGotFocus(oCtl As Object)
    If Not oCtl Is Command1 Then
        Set m_oLastFocused = oCtl
    End If
End Sub

Private Function pvInitFocusFwd(oCtl As Object, oForm As Object, Optional RetVal As cFocusFwd) As cFocusFwd
    Set RetVal = New cFocusFwd
    If RetVal.frInit(oCtl, oForm) Then
        Set pvInitFocusFwd = RetVal
    End If
End Function

Private Sub Form_Load()
    Dim oCtl        As Object

    Set m_cFocusFwds = New Collection
    For Each oCtl In Controls
        m_cFocusFwds.Add pvInitFocusFwd(oCtl, Me)
    Next
End Sub

Private Sub Command1_Click()
    MsgBox "Last active control is " & m_oLastFocused.Name, vbExclamation
End Sub

其中Command1 是处理m_oLastFocused 的命令按钮。

不幸的是，这种方法在控制数组方面存在问题。子类化方法在获得焦点的无窗口控件方面存在问题。