Flat Button in VB

How do we implement a Flat Button?

Well, let's describe step by step how we can create a usercontrol that behaves as a flat button. From VB open a new ActiveX project and save it as MyFlatButton.ctl.


Open a new ActiveX control project

Events "MouseDown" and "MouseUp" will help us to draw the edge sunken or raised when the user mouse-clicks the usercontrol. When the MouseDown event is fired we will draw a sunken edge. When the MouseUp event is fired we will draw a raised edge. This is when we should take the first decision: do we draw the edge directly from the mouse event? or should we call the Paint event instead? Is there a difference? The answer is yes, there's a big difference! Always try to have as little code as you can in procedures that are message consumers. The more code we add to the MouseDown message the slower our application will process mouse events. It is a better approach to put all drawing code in the Paint event and let the MouseDown and MouseUp events flow faster.

Let's see this with more detail. If we were drawing the button edge directly from the MouseDown event we would code something like:

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
Call pDrawEdgeSunken
End If
End Sub

Where pDrawEdgeRaised would be a procedure that draws the usercontrol edge with a sunken style. On the other hand, if we just call the Paint event our code would be:

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
m_MouseDown = True
Call UserControl_Paint
End If
End Sub

Where m_MouseDown is a boolean flag we've created to let the rest of the code know when the mouse is down. The UserControl_Paint event will have all necessary drawing code. What's the difference? well, the first version is calling procedure pDrawEdgeSunken and therefore the MouseDown event will not finish until pDrawEdgeSunken does. On the other hand, the second version calls UserControl_Paint and doesn't wait for this procedure to finish (Paint is an event procedure). It just posts a message WM_PAINT to itself and quits. This second version is more efficient and would not convert the MouseDown procedure in a potential "bottle-neck".

Using this second approach we are now going to create the first version of our flat button. You can paste the following code into your usercontrol:

Option Explicit

Public Event Click()

Private m_MouseDown As Boolean
Private m_MouseOver As Boolean
Private m_ClientRec As RECT

'API declarations:
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Const BDR_RAISEDINNER = &H4
Private Const BDR_SUNKENOUTER = &H2
Private Const BF_RECT = &HF

Private Declare Function DrawEdge Lib "user32" ( _
ByVal hdc As Long, _
qrc As RECT, _
ByVal edge As Long, _
ByVal grfFlags As Long) As Long

Private Declare Function GetWindowRect Lib "user32" ( _
ByVal hwnd As Long, _
lpRect As RECT) As Long

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
m_MouseDown = True
Call UserControl_Paint
End If
End Sub

Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Not m_MouseOver Then
m_MouseOver = True
UserControl_Paint
End If
End Sub

Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
m_MouseDown = False
UserControl_Paint
RaiseEvent Click
End If
End Sub

Private Sub UserControl_Resize()

GetWindowRect UserControl.hwnd, m_ClientRec

'Transform from screen to client coordinates
With m_ClientRec
.Right = .Right - .Left
.Bottom = .Bottom - .Top
.Left = 0
.Top = 0
End With

UserControl_Paint

End Sub

Private Sub UserControl_Paint()

Dim lEdge As Long

If Not UserControl.Ambient.UserMode Then
m_MouseOver = True
End If

UserControl.Cls

lEdge = 0

If m_MouseOver Then
If m_MouseDown Then
lEdge = BDR_SUNKENOUTER
Else
lEdge = BDR_RAISEDINNER
End If
DrawEdge UserControl.hdc, m_ClientRec, lEdge, BF_RECT
End If

'
'Add your code here to draw the picture and caption...
'

End Sub

Let's review this code before we test it. As you can see, MouseUp and MouseDown only check whether the right mouse button has been pressed and they both set the flag m_MouseDown to either True or False depending on the event. MouseMove only takes care of flag m_MouseOver and all three events call Paint to force a re-painting of the object. Resize is responsible for getting the size of the client area - using the API GetWindowRect - and also forces a re-paint. Finally the Paint event clears the usercontrol and draws the appropriate edge based on the values of m_MouseOver and m_MouseDown. Easy, isn't it?

We can now test the usercontrol. If we do so, we can see that the control first shows flat. Then, as soon as the mouse enters its client area, the control shows raised. We can now start clicking the button and the edge turns sunken when we down-click and it turns back to raised when the mouse is released.

Good, it seems to work! There are only two remaining problems:
1. The edge doesn't show flat when the mouse leaves the button.
2. The push-pop effect seems to be wrong if we mouse-click quickly.

In the next section I'm going to discuss how these two problems can be solved.


Trapping messages to solve flat button "issues"

The first question that arises is: how can we know when the mouse leaves the button? In March 1997 Microsoft published the source code of a flat button implemented with Visual Basic. The project was called Visual Basic Soft Button Sample. Since then, many soft buttons have appeared on the net and I would say all share the same technique: they use APIS SetCapture and ReleaseCapture in order to detect when the mouse leaves the button.

How does this solution work and what sort of problems does it have? Basically the solution presented by Microsoft is based on capturing the mouse when the mouse gets into the button client area. Using SetCapture, it holds the mouse until detects that it has moved outside of the button to then release it. Sounds logical? I think it is a very good approach. So what's the problem then? Well, I would say the implementation of this solution has mainly two problems:

1. SetCapture only allows one window to be holding the mouse.
2. MouseMove event will have to release and capture the mouse every time this event is fired.

We'll better understand this if we have a code sample. If we were using SetCapture and ReleaseCapture we would have to modify the MouseMove event with the following code:

Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

ReleaseCapture

If X >= 0 And _
Y >= 0 And _
X <= UserControl.ScaleWidth And _
Y <= UserControl.ScaleHeight Then

SetCapture UserControl.hwnd

m_MouseOver = True

UserControl_Paint
End If

End Sub

After calling the SetCapture API, all mouse messages, no matter where the mouse is, are posted to our window. It would be more logical if we just call SetCapture the first time we detect the mouse has entered the button area and call ReleaseCapture only once too, as soon as we detect that the mouse has left the button. We can't! Why? because only one window can hold the mouse by calling SetCapture. If an external application/code calls SetCapture while the mouse is over the button, we would lose its messages and we would never know when to call ReleaseCapture and draw the edge flat again. Therefore, the solution is based on releasing and capturing the mouse every time the user moves the mouse over the button. Not very efficient and still containing potential problems...

There's a better way to detect when the mouse leaves the button: using API TrackMouseEvent and WM_MOUSELEAVE message. TrackMouseEvent can be used to ask the system to track the mouse for us and post a WM_MOUSELEAVE message as soon as the mouse leaves our window area. It is a cleaner and more efficient approach but, how can we detect the WM_MOUSELEAVE message? We're going to use the SmartSubclass library to trap all messages posted to the usercontrol. You will have to add a reference to SmartSubclass.dll, as described in the article, and you'll be able to create a SmartSubclass variable. You'll find another example on how to use this class in Trap the Mouse!

Add the following code to the usercontrol:

Private WithEvents m_Sniff As SmartSubClass

Private Type TrackMouseEvent
cbSize As Long
dwFlags As Long
hwnd As Long
dwHoverTime As Long
End Type

Private Const WM_MOUSELEAVE = &H2A3
Private Const TME_LEAVE = &H2

Private Declare Function TrackMouseEvent Lib "comctl32.dll" Alias "_TrackMouseEvent" ( _
ByRef lpEventTrack As TrackMouseEvent) As Long

Private Sub UserControl_Initialize()
Set m_Sniff = New SmartSubClass
m_Sniff.SubClassHwnd UserControl.hwnd, True
End Sub

Private Sub UserControl_Terminate()
m_Sniff.SubClassHwnd UserControl.hwnd, False
End Sub

Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

Dim tTrackMouseEvent As TrackMouseEvent

If Not m_MouseOver Then

With tTrackMouseEvent
.cbSize = Len(tTrackMouseEvent)
.dwFlags = TME_LEAVE
.hwnd = UserControl.hwnd
End With

TrackMouseEvent tTrackMouseEvent

m_MouseOver = True
UserControl_Paint
End If

End Sub

Private Sub m_Sniff_NewMessage( _
ByVal hwnd As Long, _
uMsg As Long, _
wParam As Long, _
lParam As Long, _
Cancel As Boolean)

Select Case uMsg
Case WM_MOUSELEAVE
m_MouseOver = False
UserControl_Paint
End Select

End Sub

If you add the code to your usercontrol and you test it again, you will see that the button turns flat again as soon as the mouse leaves its client area. We've had to call TrackMouseEvent just once and when our 'sniffer' gets the WM_MOUSELEAVE message, it sets the m_MouseOver flag to False and forces a control re-painting.

I honestly prefer TrackMouseEvent to SetCapture, basically because we don't get conflicts with other windows, we rely on the system to track the mouse position and we don't need to over-charge the MouseMove event.

Now let's go back to our usercontrol. If you remember there's still a remaining problem: The "push-pop" effect seems to be wrong if we click the button fast. I describe this problem with more details in Trap the mouse!. I will only tell you that this problem is due to receiving DblClick rather than MouseDown. To fix the problem we need to get rid of the DblClick event and get MouseDown instead.

Add the following code to the usercontrol:

Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_LBUTTONDOWN = &H201

Private Sub m_Sniff_NewMessage( _
ByVal hwnd As Long, _
uMsg As Long, _
wParam As Long, _
lParam As Long, _
Cancel As Boolean)

Select Case uMsg
Case WM_MOUSELEAVE
m_MouseOver = False
UserControl_Paint

Case WM_LBUTTONDBLCLK
uMsg = WM_LBUTTONDOWN
End Select

End Sub

You can now click the flat button as fast as you want. You will always get the right "push-pop" effect. We've used our "sniffer" to get the WM_LBUTTONDBLCLK message and replaced it with a WM_LBUTTONDOWN. It couldn't be easier!

The flat button has now a very solid structure. We can only add enhancements to it. In the next section I will describe how we can make the flat button post click events when we hold the mouse down-clicked.


How can we make the flat button simulate repeated clicks?

When you hold the mouse down-clicked on the button you will get only one MouseDown message. You need to release the mouse and down-click again in order to receive the next MouseDown message. This could be a problem if we would like to use our flat button on the implementation of let's say a viewport control. The user may want to scroll the viewport area by holding the mouse down on the flat button. Makes sense. So how can we do that if Windows sends only one message? We will need to do it ourselves!

We need a timer. Actually we need two timers! We could use the Timer control that comes with Visual Basic, but we're going to use API calls. Why? because it is a good way of learning Windows core functions!

Once the user down-clicks the button we need a timer to control when to start posting Click events and we need another timer to control the frequency of this posting. Windows provides two very good timer functions, SetTimer and KillTimer, and a timer message WM_TIMER.

In order to implement the repeated click you should add the following code:

Private Const m_TimerDelay = 1
Private Const m_TimerLapse = 2
Private Const m_RepeatDelay = 250
Private Const m_RepeatLapse = 125

Private Const WM_TIMER = &H113

Private Declare Function SetTimer Lib "user32" ( _
ByVal hwnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long

Private Declare Function KillTimer Lib "user32" ( _
ByVal hwnd As Long, _
ByVal nIDEvent As Long) As Long

Private Sub m_Sniff_NewMessage(ByVal hwnd As Long, uMsg As Long, wParam As Long, lParam As Long, Cancel As Boolean)

Select Case uMsg

Case WM_MOUSELEAVE
m_MouseOver = False
UserControl_Paint

Case WM_LBUTTONDBLCLK
uMsg = WM_LBUTTONDOWN

Case WM_TIMER
Select Case wParam
Case m_TimerDelay
KillTimer UserControl.hwnd, m_TimerDelay

If m_MouseDown Then
SetTimer UserControl.hwnd, m_TimerLapse, m_RepeatLapse, 0
End If
Case m_TimerLapse
If m_MouseDown Then
RaiseEvent Click
End If
End Select

End Select

End Sub

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Button = vbLeftButton Then
m_MouseDown = True
UserControl_Paint

If m_RepeatDelay > 0 Then
SetTimer UserControl.hwnd, m_TimerDelay, m_RepeatDelay, 0
End If
End If

End Sub

Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Button = vbLeftButton Then
m_MouseDown = False

KillTimer UserControl.hwnd, m_TimerDelay
KillTimer UserControl.hwnd, m_TimerLapse

UserControl_Paint

RaiseEvent Click
End If

End Sub

Now the flat button starts waiting m_RepeatDelay milliseconds once the user down-clicks. After this time it will start posting Click events every m_RepeatLapse milliseconds.

Let's review the solution: we've modified MouseDown to program the first timer (m_TimerDelay). When the "sniffer" gets a WM_TIMER message it checks for its timer ID. If it is the first timer, the delay lapse has expired and it programs the second timer (m_TimerLapse). It also kills the first timer. Otherwise, if the WM_TIMER message belongs to the second timer, it posts a Click event (the user is holding the mouse down). Finally, the MouseUp event only has to kill both timers.

Well, that's it! Now you have a flat button working that only needs extra properties like Caption, Font, Picture, ForeColor... I will leave it up to you to implement the enhancements.