Quantcast
Channel: VBForums - CodeBank - Visual Basic 6 and earlier
Viewing all articles
Browse latest Browse all 1448

[VB6] Code Tip: Toggle Button with Image and Text (Vista+, ComCtl6)

$
0
0
NOTE: I will make a sample project, but since I had deleted this content and there was a 'please delete me' filler I wanted to repost as soon as possible. What happened was, I tried the code I posted, it seemed to work, so I posted it. I don't know if something in my system changed, or if I was hallucinating, or what, but the next minute I look and this method is not working. I came up with a fix, but it turns this from a code snippet into something fairly complicated. So standby for a sample project, but I wanted to get the post back up.


Problem: A regular CommandButton can have its image set with BM_SETIMAGE, but making it into a pushbutton (toggle button) by setting its style to BS_PUSHLIKE does not work. Conversely, a checkbox can be made into a pushbutton, but then you can't set its picture with BM_SETIMAGE and also have text.

Solution: A workable solution is to simply mimic the behavior of a pushbutton using BM_SETSTATE- which toggles whether the button is in its mousedown appearance. It stays depressed when focus is lost and when left clicked, and as far as I can tell behaves no different than a BS_PUSHLIKE button. The only trick is preventing a change to the state when focus is lost.

This code assumes you already have a project using modern common controls; see other threads for info about that.

On Form_Load, set the icon and whatever other styles you need for the button; e.g.

Code:

hBtn = Command1.hWnd
Call SendMessage(Command1.hWnd, BM_SETIMAGE, 1&, ByVal hIcon1)
SetButtonStyle Command1.hWnd, BS_NOTIFY Or BS_LEFT

hBtn is a Public Long. BS_NOTIFY is required; BS_LEFT I just added because it looks better, you can omit it or change it as long as the notify style remains. Do NOT set BS_PUSHLIKE.
Then you can toggle it on and off like this:

Code:

Private Sub Command1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If bFlag Then
    ToggleButtonState Command1.hWnd, 0
    bFlag = False
Else
    ToggleButtonState Command1.hWnd, 1
    bFlag = True
End If
End Sub


Public Sub ToggleButtonState(hWnd As Long, lState As Long)
Call SendMessage(hWnd, BM_SETSTATE, lState, ByVal 0&)
End Sub

bFlag is a project level setting you're tracking with the button state.

The big problem, and initial issue with this post, is that the button seems to lose the effect when focus is lost. Further complicating the issue, the Command_LostFocus is only fired when you click some controls and not others in VB (but the effect is lost on all), so your main form has to be subclassed to intercept the BN_KILLFOCUS message (the button itself need not be subclassed).

Code:

Public Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

'[...other subclass code]
    Case WM_COMMAND
        Dim lCode As Long
        lCode = HiWord(wParam)
        Select Case lCode
            Case BN_KILLFOCUS
                If lParam = hBtn Then
                    If bFlag Then
                        Call SendMessage(hBtn, BM_SETSTATE, 1&, ByVal 0&)
                    End If
                End If
                WndProc = 1
                Exit Function
'[...other subclass code


I know this is rather trivial, but when I came across the problem I saw lots of people asking and no adequate solutions. In modern UI's there's lots of places I prefer toggle buttons to checkboxes, so figured someone else might come across the same issue one day.


Declares and Supports
Code:

Public Const BM_SETIMAGE = &HF7
Public Const BM_SETSTATE = &HF3
Public Const BS_LEFT = &H100&
Public Const BS_NOTIFY = &H4000&
Public Const BN_KILLFOCUS = 7&
Public Const WM_COMMAND = &H111

Public Const GWL_STYLE = (-16)
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, _
                                                                    Source As Any, _
                                                                    ByVal Length As Long)

Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, _
                                                                      ByVal wMsg As Long, _
                                                                      ByVal wParam As Long, _
                                                                      lParam As Any) As Long

Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, _
                                                                          ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, _
                                                                          ByVal nIndex As Long, _
                                                                          ByVal dwNewLong As Long) As Long
Public Function SetButtonStyle(hWnd As Long, dwNewStyle As Long, Optional bAdd As Boolean = True) As Long
Dim dwStyle As Long
If bAdd Then
    dwStyle = GetWindowLong(hWnd, GWL_STYLE)
End If
dwStyle = dwStyle Or dwNewStyle
SetButtonStyle = SetWindowLong(hWnd, GWL_STYLE, dwStyle)
End Function

Public Function HiWord(dwValue As Long) As Integer
  CopyMemory HiWord, ByVal VarPtr(dwValue) + 2, 2
End Function


Viewing all articles
Browse latest Browse all 1448

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>