Focus Rect

[RobDog888]

Ok, here's the deal. In order to kill the focus rectangle you only need to prevent
the message handling by windows and basically cancel it out. This was not
as bad as I thought, but it does require subclassing.

Note: when debugging a subclassed project do not click the stop or pause
buttions in the VB IDE as it will crash your project. ALWAYS stop a project by
clicking on the forms x cancel button.

In case you dont want to download the code this example will kill the focus
rectangle of command2 command button when you click command1 button.

'BEHIND A FORM (FORM1)
Option Explicit
 
Private Sub Command1_Click()
    'PREVENT THE FOCUS RECTANGLE ON COMMAND2 COMMAND BUTTON
    SubClassHwnd Command2.hWnd
End Sub
 
 
'INSIDE A MODULE (MODULE1)
Option Explicit
'<RR VB/OUTLOOK GURU 02/04/2005 - PREVENT FOCUS RECTANGLE>
 
'GETWINDOWLONG CONSTANTS
Private Const GWL_WNDPROC   As Long = (-4)
 
'WINDOWS MESSAGE CONSTANTS
Private Const WM_NOTIFY     As Long = &H4E
Private Const WM_DESTROY    As Long = &H2
Private Const WM_SETFOCUS   As Long = &H7
Private Const WM_KILLFOCUS  As Long = &H8
 
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
 
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
 
Private Declare Function CallWindowProc Lib "user32" 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 Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
 
Private mlPrevWndProc As Long
 
Private Function WindowProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    
        Select Case Msg
        Case WM_SETFOCUS
            'KILL THE FOCUS RECTANGLE
            Exit Function
        Case WM_DESTROY
            'REMOVE SUBCLASSING WHEN COMMAND BUTTON IS DESTROYED (FORM UNLOADED)
            WindowProc = CallWindowProc(mlPrevWndProc, hWnd, Msg, wParam, lParam)
            Call SetWindowLong(hWnd, GWL_WNDPROC, mlPrevWndProc)
            Exit Function 'EXIT FUNCTION WILL PREVENT WINDOWS FROM HANDLING IT ON THE LAST LINE OF CODE
    End Select
    'CALL DEFAULT WINDOW HANDLER
    WindowProc = CallWindowProc(mlPrevWndProc, hWnd, Msg, wParam, lParam)
 
End Function
 
Public Sub SubClassHwnd(ByVal hWnd As Long)
    mlPrevWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Enjoy!

VB/Office Guru™