Autohighlight active control (SDI/more than one Form)

Posted: 2002-06-01
By: ArchiveBot
Viewed: 72

Filed Under:

VB6 Code Cache

No attachments for this post

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

Code

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


Comments on this post

No comments have been added for this post.

You must be logged in to make a comment.