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

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

About this post

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

Categories

Visual Basic 6

Attachments

No attachments for this post


Loading Comments ...

Comments

No comments have been added for this post.

You must be logged in to make a comment.