Search Tools Links Login

Autohighlight active control (SDI/more than one Form)

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.

Original Author: Marcel A. Fritsch

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!!!


Option 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)
Private Const WH_CALLWNDPROC = 4
Public Const WM_SETFOCUS = &H7
Public Const WM_KILLFOCUS = &H8
Private Type CWPSTRUCT
lParam As Long
wParam As Long
message As Long
hwnd As Long
End Type
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 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
  For Each F In Forms
  For Each C In F.Controls
   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
      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
  If found Then
   Exit For
  End If
End Select
End Function
Public Function UnHook()
If hHook Then
UnhookWindowsHookEx hHook
End If
End Function

About this post

Posted: 2002-06-01
By: ArchiveBot
Viewed: 96 times


Visual Basic 6


No attachments for this post

Loading Comments ...


No comments have been added for this post.

You must be logged in to make a comment.