Focus Rect

[LeonX]

Hello again everyone ...

Like before , i have another question to ask , this time about command button.
My question is , how to make the focus rect invisible when a command button got focus? thanks.

Regards,
Ferry

[dglienna]

just use an image. it has a click event that you can use like a button

[LeonX]

thanks dglienna,

but what i need is make the focus rect on command button not visible.
but thanks anyway.
Can anyone else help me?

[dglienna]

draw a rectangle around it that is a different color?

or display a picture of a button?

[manavo11]

I know I found this somewhere here, don't remember who posted it though :

Option Explicit
 
Private Declare Function DrawEdge Lib "user32" (ByVal hDC As Long, qrc As RECT, ByVal Edge As Long, ByVal grfFlags As Long) As Long
 
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
 
Private Const BDR_RAISEDOUTER = &H1
Private Const BDR_SUNKENOUTER = &H2
Private Const BDR_RAISEDINNER = &H4
Private Const BDR_SUNKENINNER = &H8
Private Const EDGE_RAISED = (BDR_RAISEDOUTER Or BDR_RAISEDINNER)
Private Const EDGE_SUNKEN = (BDR_SUNKENOUTER Or BDR_SUNKENINNER)
Private Const EDGE_ETCHED = (BDR_SUNKENOUTER Or BDR_RAISEDINNER)
Private Const EDGE_BUMP = (BDR_RAISEDOUTER Or BDR_SUNKENINNER)
 
Private Const BF_LEFT = &H1
Private Const BF_TOP = &H2
Private Const BF_RIGHT = &H4
Private Const BF_BOTTOM = &H8
Private Const BF_RECT = (BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM)
 
Dim Button1Border As Long
Private Sub Form_Load()
    Button1Border = EDGE_RAISED
End Sub
Private Sub Picture1_DblClick()
    Button1Border = EDGE_SUNKEN
    Picture1.Refresh
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Button1Border = EDGE_SUNKEN
    Picture1.Refresh
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Button1Border = EDGE_RAISED
    Picture1.Refresh
End Sub
Private Sub Picture1_Paint()
    Dim r As RECT
    Picture1.Cls
    r.Bottom = Picture1.ScaleHeight
    r.Right = Picture1.ScaleWidth
    DrawEdge Picture1.hDC, r, Button1Border, BF_RECT
End Sub

[manavo11]

Another way that has been posted here, again I don't remember who

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
 
Private Declare Function DrawFocusRect Lib "user32" (ByVal hdc As Long, lpRect As RECT) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
 
Private Sub Command1_GotFocus()
    Dim udtRect As RECT
    Dim lngHDC As Long
    Dim lngStatus As Long
    udtRect.Left = 4
    udtRect.Top = 4
    udtRect.Bottom = ScaleY(Command1.Height, Me.ScaleMode, vbPixels) - udtRect.Top
    udtRect.Right = ScaleX(Command1.Width, Me.ScaleMode, vbPixels) - udtRect.Left
    DoEvents
    lngHDC = GetDC(Command1.hwnd)
    lngStatus = DrawFocusRect(lngHDC, udtRect)
    ReleaseDC Command1.hwnd, lngHDC
End Sub

[LeonX]

it doesn't work . but i think that code used for draw a rectangle not to make it dissappeared , all i want is to make it(focus rectangle) dissappeared.

But thanks anyway. Please help me to resolved this.

[dglienna]

you can't use a picture of a button that doesn't have focus?

[RobDog888]

You need to subclass the command button and intercept the WM_SETFOCUS
message and change the message so its a WM_KILLFOCUS message.

Private Const WM_KILLFOCUS As Long = &H8
Private Const WM_SETFOCUS As Long = &H7

[RhinoBull]

I think subclassing might create a bit of overhead. Personally I love using DrawEdge() function - works nice. It gives you great deal of flexibility: you may have completely empty form in design filled up with many "controls" at runtime that could be functional but it may become quite tricky, tough.

[RobDog888]

Yes, subclassing is allot of work and hard to debug. But if you subclass the
form then you can sniff out all the control s you want to kill.

Personally I wouldn't do it, but if the poster is not satisfied with the previous
answers then I offered it as an alternative.

HTH

[RhinoBull]

... Personally I wouldn't do it, but if the poster is not satisfied with the previous answers then I offered it as an alternative.

HTH

Oh, yes yes, of course.
I was thinking of a completely different "overhead" ...

[LeonX]

thanks RobDog888
for your advice, now what i've got what i want, but we don't have to subclassing those command button, i can do that with this code:

Private Sub cmd_GotFocus(Index As Integer)
    SendMessage cmd(Index).hwnd, WM_KILLFOCUS, cmd(Index).hwnd, 0&
End Sub

Are those code will causes problems? BTW what is HTH stand for?

[RobDog888]

Sorry, I just didnt have the time to create an example for you but are you saying that the code you posted works?
It would be strange if it did because I dont think the third parameter will be the command button handle again.
I'm not exactly sure what the correct parameters would be for the third and fourth parameters but I thought if
this is what you wanted we could try to figure it out.

Btw, Hope This Helps.

[LeonX]

yes , its work.
But i found a little problem, when i click the 'button without focus' for the first time, the event click did not triggered. And if i show up a msgbox when i click the button then i close the msgbox, the focus rect visible again at the button.
can anyone figure it out for me, please ... .

I have an idea but do not know how to do that, something like this:

[color=#00007f]Private[/color] [color=#00007f]Sub[/color] cmd_GotFocus(Index [color=#00007f]As[/color] [color=#00007f]Integer[/color])
    If button_message = mouse_click Then ' i do not know how to get this message
        ' simulate mouse_click to this button first
    End If
    ' then kill the focus
    SendMessage cmd(Index).hwnd, WM_KILLFOCUS, cmd(Index).hwnd, 0&
End Sub

[RobDog888]

This is why I believe it needs to be handled with subclassing and intercepting the WM_SETFOCUS message.
If I get some time I will try to whip up an example for you. I currently have 3
examples to finish writting. So I will see if I can squeeze it in before bedtime.
If not I will do it over the weekend.

[dglienna]

My first idea works ?

[RobDog888]

No it doesnt work because the focus rectangle is still visible. If you use a picture of a button
that will not allow for resizing or color changes or font/language changes.

[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™

[LeonX]

Thank you, RobDog888
you help me so much ...
But, one problem solve , another problem show up.
I have an array of command button , do i need to subclass it one by one , that's mean i have to write:

Private mlPrevWndProc1 As Long
Public Sub SubClassHwnd1
Private Function WindowProc1

Private mlPrevWndProc2 As Long
Public Sub SubClassHwnd2
Private Function WindowProc2

Private mlPrevWndProc3 As Long
Public Sub SubClassHwnd3
Private Function WindowProc3

...
...
...

???
Is there any other way?


Regards,
Ferry

[boku]

im not sure but i think you can do something like this

Private mlPrevWndProc1, mlPrevWndProc2, mlPrevWndProc3 As Long

you have to test it for the other cos im not sure.

[RobDog888]

Yes, you would have to subclass each one.

You could also just subclass the entire form, but you would then have to
parse out the message parameters to determine which control was receiving
the focus.

[RobDog888]

im not sure but i think you can do something like this

Private mlPrevWndProc1, mlPrevWndProc2, mlPrevWndProc3 As Long

you have to test it for the other cos im not sure.

You cant dimension the variables that way because your only dimming the
last one as long. The first and second ones are undefined so they would be
dimmed as Variant.

[boku]

oh ok, cheers for that learn somin new lol.

[ZachFSW]

I know this is an old thread.. but I have to throw this in

Normally if someone wants to do this it is for asthetic reasons ... and the simple way to do it would be to just set the focus to something else through the click event ... the button does not have focus anymore - but that obviously is not an issue because the user would not really know what has focus anyway.

[ZachFSW]

.. (or through the onfocus event ...)

[RobDog888]

Yes, but if they dont realize that another control actually hs the focus it may cause unexpected results for the user when they try to activate the button by normal means. Killing the focus via subclassing is the best and most solid method for this.

[szlamany]

RD...

I have a control array of command buttons - and changed your code to this

Option Explicit

Private Sub Command1_Click()
    'PREVENT THE FOCUS RECTANGLE ON COMMAND2 COMMAND BUTTON
    SubClassHwnd Command2(0).hWnd
    SubClassHwnd Command2(1).hWnd
End Sub

Subclassing each index of the control array.

And that seems to work - without having to add additional WindowProc routines.

Thanks for the code!

[RobDog888]

No prob. Thanks for the update.

[Fazi]

LeonX's & szlamany's Problems are already solved i guess. Thanks to Rob's Subclassing Technique.

But there seem to be another method. That is to draw a line over the focus rect using the backcolor of the object.

In my code, i can erase my own focusrect drawn on the form. I can apply this technique to the command button as well. Problem is, i don't no how to get the rect of the focus rect drawn by the system on the command button.

Option Explicit

Private Declare Function DrawFocusRect Lib "user32" (ByVal hdc As Long, lpRect As RECT) As Long

Private Declare Function CreatePen Lib "gdi32" _
(ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long

Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long

Private Declare Function GetBkcolor Lib "gdi32.dll" Alias "GetBkColor" (ByVal hdc As Long) As Long

Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long

Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As POINTAPI) As Long

Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private rt As RECT
Private pt As POINTAPI

Private Const PS_SOLID = 0 'Brush Type

Private lpn As Long
Private lOldObj As Long

Private Sub Command1_Click()
rt.Top = 10
rt.Left = 10
rt.Right = 100
rt.Bottom = 100
DrawFocusRect Me.hdc, rt
End Sub

Private Sub EraseRect()
lpn = CreatePen(PS_SOLID, 4, GetBkcolor(Form1.hdc))
'create a pen

lOldObj = SelectObject(Form1.hdc, lpn)
'Select a Brush in to the DC

MoveToEx Form1.hdc, rt.Left, rt.Top, pt
LineTo Form1.hdc, rt.Right, rt.Top

MoveToEx Form1.hdc, rt.Right, rt.Top, pt
LineTo Form1.hdc, rt.Right, rt.Bottom

MoveToEx Form1.hdc, rt.Right, rt.Bottom, pt
LineTo Form1.hdc, rt.Left, rt.Bottom

MoveToEx Form1.hdc, rt.Left, rt.Bottom, pt
LineTo Form1.hdc, rt.Left, rt.Top

DeleteObject lpn
ReleaseDC Me.hwnd, Me.hdc

End Sub

Private Sub Command2_Click()
EraseRect
End Sub

Edited : OOoOooos, Now only noticed. A thread created way back in 2005

[szlamany]

@fazi - doesn't matter if the thread is 2 years old - anything you can add to the discusion is always appreciated

We already subclass several aspects of our user interface - capture mouse wheel scrolling so that the flexgrid the mouse is over gets scrolled nicely...

Capture WM_APPACTIVATE so that when our app re-gains focus from some other task running on the PC we know about it - something no form event tells you about.

So adding this additional subclass for WM_SETFOCUS was a simple consideration.

Our command buttons are small - so having that FOCUS RECTANGLE interferes with the "caption" on the button - simply doesn't look good. So we decided that changing the color of the button "selected" would work nicely.

Most visually appealling would be the color without the FOCUS RECTANGLE.

This image shows where we were going with all this (note that we are currently working on getting rid of the "bleed" of color that appears above the frame)

[RhinoBull]

So much about basically nothing - place controls inside picturebox and set focus to container. That's all.

[RobDog888]

So much about basically nothing - place controls inside picturebox and set focus to container. That's all.

That wont work as the focus is still desired and its function, just its appearance is not desired. If by using your method you press the space bar or enter key then there would be no action of the button since the picturebox has the focus.

[RobDog888]

LeonX's & szlamany's Problems are already solved i guess. Thanks to Rob's Subclassing Technique.

But there seem to be another method. That is to draw a line over the focus rect using the backcolor of the object.

In my code, i can erase my own focusrect drawn on the form. I can apply this technique to the command button as well. Problem is, i don't no how to get the rect of the focus rect drawn by the system on the command button.

Option Explicit

Private Declare Function DrawFocusRect Lib "user32" (ByVal hdc As Long, lpRect As RECT) As Long

Private Declare Function CreatePen Lib "gdi32" _
(ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long

Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long

Private Declare Function GetBkcolor Lib "gdi32.dll" Alias "GetBkColor" (ByVal hdc As Long) As Long

Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long

Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As POINTAPI) As Long

Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private rt As RECT
Private pt As POINTAPI

Private Const PS_SOLID = 0 'Brush Type

Private lpn As Long
Private lOldObj As Long

Private Sub Command1_Click()
rt.Top = 10
rt.Left = 10
rt.Right = 100
rt.Bottom = 100
DrawFocusRect Me.hdc, rt
End Sub

Private Sub EraseRect()
lpn = CreatePen(PS_SOLID, 4, GetBkcolor(Form1.hdc))
'create a pen

lOldObj = SelectObject(Form1.hdc, lpn)
'Select a Brush in to the DC

MoveToEx Form1.hdc, rt.Left, rt.Top, pt
LineTo Form1.hdc, rt.Right, rt.Top

MoveToEx Form1.hdc, rt.Right, rt.Top, pt
LineTo Form1.hdc, rt.Right, rt.Bottom

MoveToEx Form1.hdc, rt.Right, rt.Bottom, pt
LineTo Form1.hdc, rt.Left, rt.Bottom

MoveToEx Form1.hdc, rt.Left, rt.Bottom, pt
LineTo Form1.hdc, rt.Left, rt.Top

DeleteObject lpn
ReleaseDC Me.hwnd, Me.hdc

End Sub

Private Sub Command2_Click()
EraseRect
End Sub

Edited : OOoOooos, Now only noticed. A thread created way back in 2005

Good idea but takes more code and when the form is moved or invalidated the focus rectangle will be redrawn again by the system.

[RhinoBull]

That wont work as the focus is still desired and its function, just its appearance is not desired. If by using your method you press the space bar or enter key then there would be no action of the button since the picturebox has the focus.

So? Use the mouse. Most of skinned apps don't allow setting focus at all...
What's the big deal? Use picturebox with images to create your own button so it can get the focus but going through that much subcalssing troubles for just a "silly" focus rectangle is way too much if you ask me.

[RobDog888]

Well thats your opinion and if subclassing is already established in the project then its no extra trouble at all. Adding an extra picturebox for each button is making your form heavier and changes the functionality.

[RhinoBull]

...Adding an extra picturebox for each button is making your form heavier and changes the functionality.

How would substituting (note: not adding an extra picturebox) button with picturebox make "form heavier and change the functionality"?

[RobDog888]

This thread is getting off topic but a picturebox is considered a heavy control. Then if you have severl buttons to do that suggestion with it adds even more. As you have stated the focus not being on the button anymore will force the user to use the mouse to click it, that a change in functionality.

Later

[RhinoBull]

This thread is getting off topic but a picturebox is considered a heavy control...

I think we stay right on topic. However, who considers picturebox to be heavy? It's "heavier" than image control but only for one reason - picturebox is a window and image control is not. Command button just like picturebox is a window.
By substituting command button with picturebox you don't add much weight to your form in this case - you won't be processing large images.

But opinions vary so I figured I mention mine so everyone see the difference and have an alternative way (and btw far not a bad one).

Regards to all.

[RobDog888]

Well this was an old thread and debating which is the better method is not on topic. If you want to converse about that topic more then a new thread is needed.

Otherwise any on topic replies in regards to szlamany's thread can be made there.
http://vbforums.com/showthread.php?t=501882

Thread Closed