Image & Text On A Standard Command Button (Not Graphical Style!)- XP/2K/98

[RobDog888]

After searching a long time for code that would align the text and the image in a standard command button
without using the graphcal style or a picture of a button I decided to write my own.

I got the text alignment working with the help of Merrion here in this post and this post.

Next I needed to get the image to align also, but that seemed impossible so I figured out a workaround.

If you use a picture box control and nest it inside a command button (not just drawn on the top of it)
you can place an image anywhere you want on the button in relation to the text. I also found that this
would keep the button (in standard style) compatible with XP and its Visual Styles which are ever so popular.

Note: The XP Visual Style is achieved by using a manifest file and running on Windows XP.

I think its actually quite simple once you think about it.

One of the issues I had to figure out was when it was running under Windows 2000 or below the button click simulates
a 3D effect of a push button. So I had to find the correct offset, in pixels, to the right and down. Then if its running
under Windows XP there is no offset. So I added code to determine the OS and offset the image when pressed accordingly.



1. is the MouseOver effect in XP
2. is when the button has the focus in XP
3. is when the button is in the up position under Windows 2000 or below
4. is when the button is depressed under Windows 2000 or below


I attached a zip file of the complete working demo too.

Let me know what you think. I hope you enjoy this code.

'BEHIND A FORM (FORM1)
Option Explicit
'<10/21/2004 ROBDOG888 VB/OUTLOOK GURU>
Private mlX As Long
Private mlY As Long
 
Private Sub Command1_Click()
    Picture1.Refresh
    MsgBox "Look Manavo11, a standard command button with an aligned image and text in it!", vbOKOnly + vbInformation, _
    "RobDog888's Picture Button Demo" '
End Sub
 
Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Picture1.Move Picture1.Left + mlX, Picture1.Top + mlY
    Picture1.Refresh
End Sub
 
Private Sub Command1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Picture1.Move Picture1.Left - mlX, Picture1.Top - mlY
    Picture1.Refresh
End Sub
 
Private Sub Form_Load()
    Select Case GetFullVersion
        Case "2.5.1", "2.5.2" 'XP, SERVER 2003, +
            'OFF - NO OFFSET WHEN CLICKED
            mlX = 0
            mlY = 0
        Case Else
            'ON - OFFSET WHEN CLICKED
            mlX = 15
            mlY = 15
    End Select
    'DISABLE THE PICTUREBOX TO AVOID THE PICTUREBOX CLICK EVENT CAUSING ISSUES - THANKS JOACIM :)
    [color=red]Picture1.Enabled = False[/color] 'ADDED IN THIS POSTED CODE BUT ATTACHMENT CODE NOT UPDATED YET
    'CHANGE THE LAST PARAMETER TO CHANGE THE ALIGNMENT
    MakeGraphicalOutOfStandardButton Command1, Picture1, BS_LEFT
    'ALIGN THE TEXT OPPOSITE OF THE PICTURE ALIGNMENT
    AlignButtonText Command1, BS_RIGHT
End Sub
 
'NO LONGER NEEDED
'Private Sub Picture1_Click()
'    Command1_Click
'End Sub
 
 
'INSIDE A STANDARD MODUE (MODULE1)
Option Explicit
'<10/21/2004 ROBDOG888 VB/OUTLOOK GURU>
Private Declare Function SetParent Lib "user32.dll" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
 
Public Const BS_LEFT    As Long = &H100&
Public Const BS_RIGHT   As Long = &H200&
Public Const BS_CENTER  As Long = &H300&
Public Const BS_TOP     As Long = &H400&
Public Const BS_BOTTOM  As Long = &H800&
Public Const BS_vCENTER As Long = &HC00
 
Private Const GWL_STYLE  As Long = (-16)
 
Private Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
 
Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
 
Private Type OSVERSIONINFO
  dwOSVersionInfoSize   As Long
  dwMajorVersion        As Long
  dwMinorVersion        As Long
  dwBuildNumber         As Long
  dwPlatformId          As Long '1 = Windows 95. '2 = Windows NT
  szCSDVersion          As String * 128
End Type
 
Private Declare Function GetVersionExA Lib "kernel32" (lpVersionInformation As OSVERSIONINFO) As Integer
 
Public Function AlignButtonText(ByRef oCmdBtn As CommandButton, ByVal lStyle As Long)
'<10/21/2004 ROBDOG888 VB/OUTLOOK GURU>
'Note: Align text to make room for the image. Depends on type of alignment passed
    Dim lRet As Long
    If lStyle = BS_RIGHT Then
        lRet = GetWindowLong(oCmdBtn.hwnd, GWL_STYLE) And Not lStyle
        oCmdBtn.Caption = oCmdBtn.Caption & Chr(32)
    ElseIf lStyle = BS_LEFT Then
        lRet = GetWindowLong(oCmdBtn.hwnd, GWL_STYLE) And Not lStyle
        oCmdBtn.Caption = Chr(32) & oCmdBtn.Caption
    ElseIf lStyle = BS_CENTER Then
        lRet = GetWindowLong(oCmdBtn.hwnd, GWL_STYLE) And Not BS_RIGHT Or BS_LEFT
    End If
    lRet = SetWindowLong(oCmdBtn.hwnd, GWL_STYLE, lRet Or lStyle)
    oCmdBtn.Refresh
End Function
 
Public Function MakeGraphicalOutOfStandardButton(ByRef oCmdBtn As CommandButton, ByRef oPic As PictureBox, ByVal lStyle As Long)
'<10/21/2004 ROBDOG888 VB/OUTLOOK GURU>
'Note: If running XP+ then dont need to adjust pic left and down when the button is clicked
'      In the Button_Click, Button_MouseDown, and the Button_MouseUp events place a refresh method for the pic
    SetParent oPic.hwnd, oCmdBtn.hwnd
    If lStyle = BS_RIGHT Then
        '95 IS THE BUFFER SPACING WHEN RIGHT ALIGNED
        oPic.Move (oCmdBtn.Width - oPic.Width) - 95, (oCmdBtn.Height / 2) - (oPic.Height / 2)
    ElseIf lStyle = BS_LEFT Then
        '95 IS THE BUFFER SPACING WHEN LEFT ALIGNED
        oPic.Move 95, (oCmdBtn.Height / 2) - (oPic.Height / 2)
    ElseIf lStyle = BS_CENTER Then
        oPic.Move (oCmdBtn.Width / 2) - (oPic.Width / 2), (oCmdBtn.Height / 2) - (oPic.Height / 2)
    End If
    oPic.Refresh
End Function
 
Public Function GetFullVersion() As String
'<07/07/2004 ROBDOG888 VB/OUTLOOK GURU>
    Dim osinfo  As OSVERSIONINFO
    Dim lRetVal As Integer
    osinfo.dwOSVersionInfoSize = 148
    osinfo.szCSDVersion = Space$(128)
    lRetVal = GetVersionExA(osinfo)
    GetFullVersion = osinfo.dwPlatformId & "." & osinfo.dwMajorVersion & "." & osinfo.dwMinorVersion
End Function

VB/Office Guru™