どのコントロールにフォーカスがあるかを示すコマンドボタンを作成するにはどうすればよいですか？

Question

VB6フォームにコマンドボタンを配置しました。私はこのボタンをクリックすると、最も最近フォーカスがあったコントロールを示すメッセージがポップアップされるようにしたいと思います。

私はコマンドボタンを押すと、コマンドボタンがフォーカスを受け取ることがわかります。私はコマンドボタンがフォーカスを離れてから、どのコントロールにフォーカスがあるかを知ることに興味があります。どうすればいい？

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 

その後Command1がm_oLastFocusedを処理しているコマンドボタンでこの

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 

などのフォーカスを取得した子コントロールに通知ControlGotFocusコールバックを受け取るためにあなたの形でそれを使用します。

残念ながら、このアプローチでは制御配列に問題があります。サブクラス化アプローチは、フォーカスを得ることができるウィンドウレスコントロールにも問題があります。