by Marcel A. Fritsch (3 Submissions)
Category: Windows API Call/Explanation
Compatability: Visual Basic 3.0
Difficulty: Intermediate
Date Added: Wed 3rd February 2021
Rating: 
(3 Votes)
This is a very simple and useful solution to highlight input controls without writting a function for each control. Only include a module with the code shown below and call SetHook at the beginning of your application and Unhook at the end. Please vote, if you think its a good solution.
Side Effects
When running this progam in the IDE do not use the STOP-Button to exit the program, because the unhook function will not be executed and the IDE crashes!!!
VBcodersOption Explicit
' USER32 functions
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 CallNextHookEx Lib "user32" _
(ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
' KERNEL32 functions
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
' CONSTANTS
Private Const WH_CALLWNDPROC = 4
Public Const WM_SETFOCUS = &H7
Public Const WM_KILLFOCUS = &H8
' STRUCTS
Private Type CWPSTRUCT
lParam As Long
wParam As Long
message As Long
hwnd As Long
End Type
' REST
Private hHook As Long
'
Public Function SetHook()
If Not hHook Then
hHook = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf WndProc, App.hInstance, App.ThreadID)
End If
End Function
'
Private Function WndProc(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim CWP As CWPSTRUCT
Dim C As Control
Dim F As Form
Dim found As Boolean
On Local Error Resume Next
CopyMemory CWP, ByVal lParam, Len(CWP)
WndProc = CallNextHookEx(hHook, idHook, wParam, ByVal lParam)
Select Case CWP.message
Case WM_SETFOCUS, WM_KILLFOCUS
For Each F In Forms
For Each C In F.Controls
Err.Clear
If CWP.hwnd = C.hwnd Then
If Err.Number = 0 Then
If CWP.message = WM_SETFOCUS Then
If (TypeOf C Is TextBox) Or _
(TypeOf C Is ComboBox) Then
C.BackColor = &H80000018
End If
Else
If (TypeOf C Is TextBox) Or _
(TypeOf C Is ComboBox) Then
C.BackColor = &H80000005
End If
End If
found = True
Exit For
End If
End If
Next
If found Then
Exit For
End If
Next
End Select
End Function
'
Public Function UnHook()
If hHook Then
UnhookWindowsHookEx hHook
End If
End Function
