Adding Custom button in titlebar of userform

[GTO]

Hi There,

Maybe this has to do with the users one is faced with, but adding custom buttons to the titlebar seems non-intuitive for the users. Shucks, least as I can see, the use of the close button (or the close button and the minimize and restore/maximize buttons) is one of the few things we can safely bet on the user not mucking up. Now we want to "un-train" the user? Again, maybe just the users I am used to, so onward...

Hopefully someone will take pity and point out how to do this if I am incorrect, but I see no way of actually creating an additional custom button in the titlebar of a userform with VBA and/or API.

I would note that as a concept it certainly seems possible, as I did find this in C# : http://www.codeproject.com/KB/cs/mintraybtn.aspx

Unfortunately, I do not understand the code to even know if the efforts are translatable.

If this is possible through VB6 as you indicated, maybe zip a text file with the code. Then maybe someone could see a way in VBA?

I did find a workaround in VB, that I was able to carry over to VBA. Quite frankly, this seems far too mucky to me to be worth it, but for what its worth:

In a Standard Module:

'//*****************************************************************************//
'// Using code adapted from Masaru Kaji (Colo) at:                              //
'// http://puremis.net/excel/code/024.shtml                                     //
'// and code for grabbing a label as a pseudo titlebar at:                      //
'// http://www.developerfusion.com/code/...stom-title-bar                   //
'//*****************************************************************************//
Option Explicit
 
Public Declare Function ReleaseCapture Lib "user32" () As Long
 
Public Declare Function SendMessage Lib "user32" _
                         Alias "SendMessageA" (ByVal hWnd As Long, _
                                               ByVal wMsg As Long, _
                                               ByVal wParam As Long, _
                                               ByRef lParam As Any _
                                               ) As Long
 
Public Declare Function SetWindowText Lib "user32" _
                         Alias "SetWindowTextA" (ByVal hWnd As Long, _
                                                 ByVal lpString As String _
                                                 ) 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 Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long _
                                                  ) As Long
 
Public Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, _
                                                  ByVal lpWindowName As String _
                                                  ) As Long
 
Public Const HTCAPTION = 2
Public Const WM_NCLBUTTONDOWN = &HA1
Public Const GWL_STYLE = -16
Public Const WS_CAPTION = &HC00000
 
Public Function TitleBar_Hide(UF As Object, lUFHandle As Long)
Dim lWindow As Long
 
    lUFHandle = FindWindowA(vbNullString, UF.Caption)
    lWindow = GetWindowLong(lUFHandle, GWL_STYLE)
    lWindow = lWindow And (Not WS_CAPTION)
    Call SetWindowLong(lUFHandle, GWL_STYLE, lWindow)
    Call DrawMenuBar(lUFHandle)
End Function

In a new UserForm, with two labels, three command buttons, and one image control, all named as indicated...

Userform Module:

Option Explicit
 
Dim hWnd As Long
 
Private Sub cmdCancel_Click()
    Unload Me
End Sub
 
Private Sub lblTitleBar_MouseDown(ByVal Button As Integer, _
                             ByVal Shift As Integer, _
                             ByVal X As Single, _
                             ByVal Y As Single)
    '// I have read exactly nothinig on ReleaseCapture and have very little true    //
    '// grasp on SendMessage, so this part is mostly like electricity to a five     //
    '// year old.  Its magic, it works, I cannot see how, but I know not to stick a //
    '// butter knife into a socket.                                                 //
    ReleaseCapture
    SendMessage hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
End Sub
 
Private Sub cmdClose_Click()
    Unload Me
End Sub
 
Private Sub cmdSpecial_Click()
    MsgBox "Hello World!", 0, vbNullString
End Sub
 
Private Sub UserForm_Initialize()
Dim lRetVal As Long
 
Const TITLEBAR_HGT As Double = 14
Const TITLEBAR_CAPTION As String = "Fake TitleBar"
    With Me '(frmFakeTitlebar)
        .Caption = "Fake Titlebar"
        .Width = 240
 
        With .lblTitleBar
            .BackColor = &H8000000F
            .BorderStyle = fmBorderStyleNone
            '// What the caption is doesn't matter, but we do need one, as we'll    //
            '// use it for SetWindowText                                            //
            .Caption = "My TitleBar"
            .Height = TITLEBAR_HGT
            .Width = .Parent.Width + 4
            .Left = -2
            .Top = 0
            .Picture = Me.imgMyTitlebar.Picture
        End With
        '// The image control would have a picture saved of whatever color/gradient //
        '// that best reflects the normal titlebar.  I believe that this is another //
        '// area where the workaround comes up short, as (didn't bother testing) I'm//
        '// fairly certain that if the user chooses different 'looks' for the       //
        '// windows' appearance, we cannot replicate on the fly?                    //
        '// Note that we set the image control's visibility to False, effectively   //
        '//burying it behind lblTitleBar                                            //
        With .imgMyTitlebar
            .BorderStyle = fmBorderStyleNone
            .Height = 15
            .Width = 244
            .Left = -2
            .Top = 0
            .Visible = False
        End With
        With .lblCaption
            .BackStyle = fmBackStyleTransparent
            .Caption = TITLEBAR_CAPTION
            With .Font
                .Bold = False
                .Name = "System"
                .Size = 9
                .Underline = False
            End With
            .ForeColor = &HFFFFFF
            .Height = TITLEBAR_HGT
            .Width = Me.Width * 0.667
            .Left = 2
            .Top = 0
            .TextAlign = fmTextAlignLeft
        End With
        '// Here's about the best I could manage.  As command buttons appear to have//
        '// a non-adjustable internal margin for the caption, same as the label used//
        '// as a titlebar, I used the picture property and cropped screen shots for //
        '// the images.  Admittedly extrememly rudimentary...                       //
        With .cmdClose
            .Height = 12
            .Width = 12
            .Left = .Parent.Width - 17
            .Top = 1
            .TabStop = False
        End With
 
        With .cmdSpecial
            .Height = 12
            .Width = 12
            .Left = .Parent.Width - 30
            .Top = 1
            .TabStop = False
        End With
 
        '// Now, any other controls we are adding need to be positioned offset to   //
        '// lblTitleBar's height, as using any type of common spacing such as 12 or //
        '// 6, would of course result in the control being up in the new 'titlebar's'//
        '// area.  Although I think this whole idea seems a bit mucky, I would use  //
        '// a Constant to at least make it a bit easier.                            //
        With .cmdCancel
            .Caption = "Unload"
            .Font.Size = 11
            .Height = 22
            .Width = 45
            .Left = 186
            .Top = TITLEBAR_HGT + 12
        End With
        .Height = .cmdCancel.Top + .cmdCancel.Height + 12
    End With
 
    '// Hide the normal titlebar                                                    //
    TitleBar_Hide Me, hWnd
    '// Get the fake titlebar (label) set up so it can be used to 'grab/drag' the   //
    '// form like the titlebar normally would.                                      //
    lRetVal = SetWindowText(hWnd, Me.lblTitleBar.Caption)
End Sub

Note: I am writing in xl2000, and for some reason, I seem to recall hWnd being available in 2003. I might well be recalling incorrectly, but of course if it is, this would save a step.

As mentioned, I certainly think this is too mucky. Regardless of opinion as to whether sticking extra buttons in the titlebar is the way to go about it, unless there is a proper way of getting a button added to the actual titlebar, I would be at Bob's question, as to why would we want to?

Regardless, if this is the route you want to take, I hope this helps,

Mark