Как мне создать командную кнопку, которая сообщает мне, какой элемент управления имеет фокус?

Question

Я поместил командную кнопку в форму VB6.Я хотел бы сделать так, чтобы, если я нажму на эту кнопку, появится всплывающее сообщение, указывающее, какой элемент управления последний раз имел фокус.

Я знаю, что если я нажму командную кнопку, это заставит командную кнопку получить фокус.Я заинтересован в том, чтобы выяснить, какой элемент управления был в фокусе, просто ДО того, как командная кнопка отвела фокус от него.Как бы я это сделал?

Answer 1

Подкласс кнопка.
Ручка 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

Вам понадобится простой вспомогательный класс переадресации фокуса, чтобы сделать это без подклассов, как этот (неполный пример класса)

' 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.

К сожалению, у этого подхода есть проблемы с массивами управления.Подклассифицированный подход имеет проблемы с элементами управления без окон, которые тоже могут сфокусироваться.

Answer 3

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