[VB6] CC6 Graphical Buttons

[dilettante]

We have "graphical style" command buttons, but they won't accept Common Controls 6 UxTheme adjustments. However I have found a way around this:

Option Explicit

'Demonstrates using CommandButtons where Style = vbButtonStandard and
'Picture = <some icon> along with a Common Controls 6 manifest to get
'"graphical" buttons with CC6 styling and effects.
'
'Why do this?
'
'It can come in handy when you want to make a "toolbar" without the
'need to deploy any toolbar OCX.  Just put them into a PictureBox,
'UserControl, etc.
'
'And some people just like to have icons on buttons here and there.

Private Const BM_SETIMAGE As Long = &HF7&
Private Const IMAGE_ICON As Long = 1

Private Declare Function SendMessage Lib "user32" Alias "SendMessageW" ( _
    ByVal hWnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long

Private Const GWL_STYLE As Long = -16&

Private Enum BS_TEXTALIGN_STYLES
    [_BS_TEXTPOSMASK] = &HF00&
    'Note: the next two values seems to be swapped in winuser.h, or at least
    'have the opposite meaning when used with an icon, so I have swapped them:
    BS_RIGHT = &H100&
    BS_LEFT = &H200&
    'Note: the next two values seems to be swapped in winuser.h, or at least
    'have the opposite meaning when used with an icon, so I have swapped them:
    BS_BOTTOM = &H400&
    BS_TOP = &H800&
    BS_CENTER = &H300&
End Enum

Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongW" ( _
    ByVal hWnd As Long, _
    ByVal nIndex As Long) As Long

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongW" ( _
    ByVal hWnd As Long, _
    ByVal nIndex As Long, _
    ByVal dwNewLong As Long) As Long

Private Sub IconizeButton( _
    ByVal CommandButton As CommandButton, _
    Optional ByVal TextAlignment As BS_TEXTALIGN_STYLES = BS_BOTTOM)
    'Assumes the CommandButton has an icon as its Picture property.
    Dim NewStyle As Long
    
    With CommandButton
        NewStyle = GetWindowLong(.hWnd, GWL_STYLE) And Not [_BS_TEXTPOSMASK] Or TextAlignment
        SetWindowLong .hWnd, GWL_STYLE, NewStyle
        SendMessage .hWnd, BM_SETIMAGE, IMAGE_ICON, .Picture.Handle
    End With
End Sub

Private Sub Form_Load()
    IconizeButton cmdBurn
    IconizeButton cmdSave
    IconizeButton cmdSmiley
    IconizeButton cmdSomeButton, BS_CENTER
    IconizeButton cmdSubmit, BS_LEFT
End Sub

These buttons are larger than they need to be, and a normal toolbar would probably use smaller icons anyway:

As it begins




Tabbed to move focus, hovering mouse




Just hovering

I put my "toolbar buttons" within a PictureBox, but I haven't figured out how to theme that to look like a proper toolbar. Maybe the BackColor at least ought to be a different color? There are no borders but a Line control at the "bottom" of the PictureBox is standing in for one here.


Requirements

Should work on Windows XP or later. Reports say no on XP though.

Tested, working on Windows 10, Windows 7, Windows Server 2008 R2.

IDE runs of course look clunky and the icons don't show, but if you apply a CC6 manifest to the IDE that might not happen. I haven't tried this since I don't use an IDE manifest for theming.