Using WinAPI to change the color on the title bar of a UserForm

[abdelfattah]

hello
I search for highlight the title bar of a UserForm .
I have this code should highlight red ,but it doesn't

Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function SetSysColors Lib "user32" (ByVal nChanges As Long, lpSysColor As Long, lpColorValues As Long) As Long
Private originalColor As Long
Private Sub UserForm_Activate()
  originalColor = GetSysColor(2)
  Call SetSysColors(1, 2, RGB(255, 0, 0))  'RGB(255,0,0) = RED
End Sub
Private Sub UserForm_Terminate()
  Call SetSysColors(1, 2, originalColor)
End Sub

any solution experts ?

 

[Dan_W]

Oh wow, I wasn't even sure that idea would work, but I will definitely give it a go, thank you.

I was just in the middle of reading the createshadow code and rereading your info about it. I had missed the bit about it being a button(!), so am just working out how it all works now... I am familiar with the project you drew this from, so will take another look at that to make sure I'm implementing it correctly. It seems that all it needs is a hwnd.

 

[Jaafar Tribak]

@Dan_W

I think the Class Shadow written by Leandro uses the same idea : ie:= Having a syncchroised shadow window sitting underneath the form.

The only other alternative I can think of is using a Window Pen and painting two fine lines onto the screen DC. One horiz line and one vert line along the right and bottom edges of the userform. This should be less heavy than having an entire shadow winodw placed underneath the form but I am worried it will probably cause some flickering when moving the form around.

 

[Dan_W]

@Dan_W

I think the Class Shadow written by Leandro uses the same idea : ie:= Having a syncchroised shadow window sitting underneath the form.

The only other alternative I can think of is using a Window Pen and painting two fine lines onto the screen DC. One horiz line and one vert line along the right and bottom edges of the userform. This should be less heavy than having an entire shadow winodw placed underneath the form but I am worried it will probably cause some flickering when moving the form around.

Well this was concern with the userform approach - it felt like it was going to be 'heavy'. I hadn't realised that Leandro had taken the same approach - it looked really nice, but then I think to see how it moved, etc. That, and it was a compiled version I saw, so.

I've been teaching myself GDI/GDI+ mostly from your code, but also from the VBForums/PlanetSourceCode materials, and the thought of drawing a shadow did occur to me, but the only DCs I could think of to use was the Userform DC (can't use that for a 'shadow'), another userform (in which case, why use a DC), or the screen - but as you say, the flickering might be distracting. I've worked out how to implement double buffering, but the idea of double buffering a screen DC for a moving userform just feels odd.

I've been looking at the code you used for the other project, and (1) it's dawning on me that I should've just started with your project and removed some things (you've done all the hard work already) - specifically, I will likely need to draw from your _MouseMove and _MouseDown routines; and (2) you've inadvertently given me the solution to two other problems I've had for a while now (so thank you very, very much).

One other thing - you will see that I have used Unload to close the window. Thinking that someone would take issue with me doing that, I looked into alternatives without requiring the person using the class to add additional code in the userform (ie. a single, hassle-free drop-in class). I tried PostMessage with WM_Close.... On the plus side, it executed the QueryClose event, as I had hoped it would, but let's just say that it took Excel crashing 9 times in succession and an hour of me muttering at the monitor to realise that that was a bad idea... Is it ok to use unload? It seems to work - that is to say that it doesn't crash Excel, which is really my ultimate goal for all my projects

 

[abdelfattah]

@Dan_W

Changing the caption property of the userform after the styles have been applied instantly removes them

what do you mean?
if I change the name of form by the caption property waht happens ? I don't note anything when change it .
what's the problem ?

 

[abdelfattah]

@Dan_W

and unless I hear anything further from @abdelfattah

actually I try to understand what's the problem in shadow . I move the form to see the problem but I can't note specific problem that's why I can't answer you .

 

[gravanoc]

What a coincidence, I was stopping by because I found @Jaafar Tribak 's code in a search. I have a couple of questions, hopefully not retreading something.

Really amazing work again Jaafar, thanks for spending the time to make this happen.

I found that the text in the title was clipped for certain letters like 'y', so I modified the cTitleBar in a couple of places that apparently were relevant. I commented out the original and put a slightly different version in their place.

With tClientRect
        Call SetRect(tTitleBarRect, 0, -tMt.FrameHeight, .Right, .Top + tMt.CaptionHeight + 8)
'        Call SetRect(tTitleBarRect, 0, -tMt.FrameHeight, .Right, .Top + tMt.CaptionHeight + 1)
    End With

With tClientRect
'        Call SetRect(tTitleBarRect, 0, 0, .Right, tMt.CaptionHeight + tMt.FrameHeight)
        Call SetRect(tTitleBarRect, 0, 0, .Right, tMt.CaptionHeight + tMt.FrameHeight + 12)
    End With

Is this the recommended way to get a taller title bar, or do you suggest something else? Also, would you recommend using this API code in a project meant for wide use? Are there any issues you're aware of?

 

[Dan_W]

Changes to the Caption property

@Dan_W

what do you mean?
if I change the name of form by the caption property waht happens ? I don't note anything when change it .
what's the problem ?

Hi. Sorry, I should've been clearer (I need remind myself sometimes that other people can't read my mind )
So if you make a slight amendment to sample code above, you should be able to see what I'm talking about:

Private CustomForm As New cCustomUserform

Private Sub UserForm_Click()
    Me.Caption = "The time is now " & Format(Now, "11:MM;SS")
End Sub

Private Sub UserForm_Initialize()
    Me.Caption = "This is a test"
    CustomForm.TitleBarColor = RGB(120, 0, 0)
    Set CustomForm.Form = Me
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Set CustomForm = Nothing
End Sub

Basically, if you change the caption after the userform has started and the custom titlebar has been made, then the style used to remove both the real titlebar and the border will come undone. The picture on the left shows the userform on startup. The picture on the right shows what happens when you run the code above, and then click the userform.

Shadow
As for the shadow, I was going to keep it the code as an option, but simply not to have it enabled by default as it currently is with the first version of the code. In addition to the points raised by Jaafar, you might be able to see that it's fairly unreliable as well. For example, if you change the ShowModal property of the userform to False, and then start the userform, you'll see that the shadow will suddenly disappear when you click on the worksheet.

The picture on the right is what I believe Jaafar is referring to with: "This will leave any subsequent userforms looking with a double frame"

But if it works for you the way you want it to, then that's great. I just want to make sure that any silly bugs in the code are corrected in case anyone else might want to use it - and it's better to do it while I remember what it all means than in a years time when somebody notices an error. There's no hurry at all though, and I'm sorry if seems like I'm rushing you - I'm not.

I had hoped I'd be finished with the changes by tomorrow, but things just got busy at work today, so I was being a bit optimistic. I'll let you both know how I get on.

 

[Jaafar Tribak]

@gravanoc

I found that the text in the title was clipped for certain letters like 'y', so I modified the cTitleBar in a couple of places that apparently were relevant. I commented out the original and put a slightly different version in their place.

It is difficult to get the precise location of the text when the code is meant to work with different fonts.

If you are not using artistical font, I suggest you do this :

in the DrawActiveCaption SUB

With tClientRect
    Call SetRect(tTitleBarRect, 0, -tMt.FrameHeight, .Right, .Top + tMt.CaptionHeight)
End With

....

With tClientRect
    Call SetRect(tTitleBarRect, 0, 0, .Right, tMt.CaptionHeight + tMt.FrameHeight)
End With

and then (Note that I just removed (+ tMt.FrameHeight) form the SetRect API.)

    With tTitleBarRect
        If bCenterText Then
            Call SetRect( _
                tTextPosRect, ((.Right) - (tTextRect.Right)) / 2, _
                ((tMt.CaptionHeight + tMt.FrameWidth) - tTextRect.Bottom) / 2, _
                .Right, _
                .Bottom)
        Else
            Call SetRect( _
                tTextPosRect, _
                IIf(hIcon, GetSystemMetrics(SM_CXICON) + _
                GetSystemMetrics(SM_CXFRAME), _
                GetSystemMetrics(SM_CXFRAME) + _
                GetSystemMetrics(SM_CXBORDER)), _
                 ((tMt.CaptionHeight + tMt.FrameWidth) - tTextRect.Bottom) / 2, _
                .Right, _
                .Bottom)
        End If
    End With

Do the same in the DrawInActiveCaption SUB.

Also, would you recommend using this API code in a project meant for wide use? Are there any issues you're aware of?

As far as I can tell, I don't really see any serious potential issues with the code if only because the code does not make use of subclassing and\or hooking techniques and hence no risk of crashing excel even if an accidental error occurs.

PS:
You can also take a look at Dan_W 's code in POST#15. Works realy well + less code.

 

[Jaafar Tribak]

One other thing - you will see that I have used Unload to close the window. Thinking that someone would take issue with me doing that, I looked into alternatives without requiring the person using the class to add additional code in the userform (ie. a single, hassle-free drop-in class). I tried PostMessage with WM_Close.... On the plus side, it executed the QueryClose event, as I had hoped it would, but let's just say that it took Excel crashing 9 times in succession and an hour of me muttering at the monitor to realise that that was a bad idea... Is it ok to use unload?

@Dan_W

I am not sure I exactly understand the issue , but Unload is the way to properly close the form when pressing ESC or when clicking the X menu button.

BTW, setting the Cancel Property of the hidden button to FALSE at runtime may cancel out a design-time Cancel button that the user may already have.... Adding a right-click menu for closing or hooking a different key is possible but kind of messy... but, maybe, I am just splitting hairs here

 

[Jaafar Tribak]

@Dan_W

Hi ,
I have given a try to the Pen alternative shadow painting I mentioned earlier. The painting is actually on the Form DC (not on the screen).
I have used combined Regions to properly place the right & bottom shadow lines... The result turned out to be better than I had initially thought.

Here is your modified code

CustomTitleBarShadow.xlsm

cCustomUserform Module

Option Explicit

'
'        SAMPLE CODE
'
'        Private CustomForm As New cCustomUserform
'
'        Private Sub UserForm_Initialize()
'
'            ' This useform sets both the TitleBarColor and HoverColor properties,
'            ' and disables the Close Button. Press escape to close the userform.
'
'            Me.Caption = "Press escape to quit"
'            CustomForm.TitleBarColor = RGB(100, 180, 180)
'            CustomForm.HoverColor = RGB(0, 120, 120)
'            CustomForm.DisplayCloseButton = False
'            Set CustomForm.Form = Me
'
'        End Sub
'
'        Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
'
'            Set CustomForm = Nothing
'
'        End Sub

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

       
#If VBA7 Then
    #If Win64 Then
        Private Declare PtrSafe Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As Long
        Private Declare PtrSafe Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As Long
    #Else
        Private Declare PtrSafe Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
        Private Declare PtrSafe Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As Long
    #End If
   
    Private Declare PtrSafe Function ColorAdjustLuma Lib "SHLWAPI.DLL" (ByVal clrRGB As Long, ByVal n As Long, ByVal fScale As Long) As Long
    Private Declare PtrSafe Function DrawMenuBar Lib "user32.dll" (ByVal hwnd As LongPtr) As Long
    Private Declare PtrSafe Function GetClassLong Lib "user32.dll" Alias "GetClassLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As Long
   
   
    Private Declare PtrSafe Function OleTranslateColor Lib "oleAut32.dll" (ByVal clr As OLE_COLOR, ByVal palet As LongPtr, Col As Long) As Long
    Private Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long
    Private Declare PtrSafe Function ReleaseCapture Lib "user32.dll" () As Long
    Private Declare PtrSafe Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As Long
    Private Declare PtrSafe Function SetClassLong Lib "user32.dll" Alias "SetClassLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
   
    Private hwnd                                    As LongPtr
    Private WindowStyle                             As LongPtr
   
    Private Declare PtrSafe Function GetClientRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
    Private Declare PtrSafe Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As LongPtr
    Private Declare PtrSafe Function CombineRgn Lib "gdi32" (ByVal hDestRgn As LongPtr, ByVal hSrcRgn1 As LongPtr, ByVal hSrcRgn2 As LongPtr, ByVal nCombineMode As Long) As Long
    Private Declare PtrSafe Function SetWindowRgn Lib "user32" (ByVal hwnd As LongPtr, ByVal hRgn As LongPtr, ByVal bRedraw As Long) As Long
    Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtr, ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hUf As LongPtr) As Long
    Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hDC As LongPtr) As Long
    Private Declare PtrSafe Function LineTo Lib "gdi32" (ByVal hDC As LongPtr, ByVal x As Long, ByVal y As Long) As Long
    Private Declare PtrSafe Function MoveToEx Lib "gdi32" (ByVal hDC As LongPtr, ByVal x As Long, ByVal y As Long, ByVal lpPoint As Long) As Long
    Private Declare PtrSafe Function TranslateColor Lib "oleAut32.dll" Alias "OleTranslateColor" (ByVal clr As OLE_COLOR, ByVal palet As LongPtr, Col As Long) As Long
    Private Declare PtrSafe Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As LongPtr
    Private Declare PtrSafe Function SelectObject Lib "gdi32" (ByVal hDC As LongPtr, ByVal hObject As LongPtr) As LongPtr
    Private Declare PtrSafe Function DeleteDC Lib "gdi32" (ByVal hDC As LongPtr) As Long
    Private Declare PtrSafe Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As Long
   
#Else
    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA " (ByVal hwnd As Long , ByVal nIndex As Long, ByVal dwNewLong As Long ) As Long
    Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long

    Private Declare Function ColorAdjustLuma Lib "SHLWAPI.DLL" (ByVal clrRGB As Long, ByVal n As Long, ByVal fScale As Long) As Long
    Private Declare Function DrawMenuBar Lib "user32.dll" (ByVal hWnd As Long) As Long
    Private Declare Function GetClassLong Lib "user32.dll" Alias "GetClassLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
    Private Declare Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hUf As Long) As Long
    Private Declare Function OleTranslateColor Lib "oleAut32.dll" (ByVal clr As OLE_COLOR, ByVal palet As Long, col As Long) As Long
    Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    Private Declare Function ReleaseCapture Lib "user32.dll" () As Long
    Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    Private Declare Function SetClassLong Lib "user32.dll" Alias "SetClassLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
   
    Private hwnd                                    As Long
    Private WindowStyle                             As Long
   
    Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
    Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
    Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
    Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long
    Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
    Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
    Private Declare Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hUf As Long) As Long
    Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long
    Private Declare Function LineTo Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long) As Long
    Private Declare Function MoveToEx Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal lpPoint As Long) As Long
    Private Declare Function TranslateColor Lib "oleAut32.dll" Alias "OleTranslateColor" (ByVal clr As OLE_COLOR, ByVal palet As Long, Col As Long) As Long
    Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
    Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
    Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
    Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

#End If
 
    Private Const CS_DROPSHADOW                     As Long = &H20000
    Private Const GCL_STYLE                         As Long = (-26)
    Private Const GWL_STYLE                         As Long = (-16)
    Private Const GWL_EXSTYLE                       As Long = (-20)
    Private Const HTCAPTION                         As Long = 2
    Private Const WM_NCLBUTTONDOWN                  As Long = &HA1
    Private Const WS_CAPTION                        As Long = &HC00000
    Private Const WS_EX_DLGMODALFRAME               As Long = &H1
   
    Private WithEvents CancelBUtton                 As MSForms.CommandButton
    Private WithEvents cForm                        As MSForms.UserForm
    Private WithEvents NewTitleBar                  As MSForms.Label
    Private WithEvents NewTitleBarCaption           As MSForms.Label
    Private WithEvents NewCloseButton               As MSForms.Label
   
    Event CancelBUtton(ByRef Handled As Boolean)
   
    Private cDisplayCloseButton                     As Boolean
   
    Private cCaption                                As String
    Private cCaptionColor                           As Long
    Private cCaptionHoverColor                      As Long
    Private cDropShadow                             As Boolean
    Private cFocusOnForm                            As Boolean
    Private cFormSet                                As Boolean
    Private cFocusOnCloseButton As Boolean
    Private cHoverColor                             As Long
    Private cHoverColorSetByUser                    As Long
    Private cTitleBarColor                          As Long
    Private cTitleBarColorSetByUser                 As Long



    Private Sub cForm_Layout()
        Call CreateShadow
    End Sub

    ' Class Events
       
    Private Sub Class_Initialize()
        cTitleBarColorSetByUser = -1
        cHoverColorSetByUser = -1
        cDisplayCloseButton = True
        cCaption = "Default"
    End Sub
   
    Private Sub Class_Terminate()
        Set cForm = Nothing
    End Sub
   
    ' Properties
   
    Public Property Get TitleBarColor() As Long
        TitleBarColor = cTitleBarColor
    End Property
   
    Public Property Let TitleBarColor(uColor As Long)
        cTitleBarColorSetByUser = uColor
        cCaptionColor = BlackOrWhite(cTitleBarColorSetByUser)
        If cFormSet = True Then Apply
    End Property
   
    Public Property Get HoverColor() As Long
        HoverColor = cHoverColor
    End Property
   
    Public Property Let HoverColor(uColor As Long)
        cHoverColorSetByUser = uColor
        cCaptionHoverColor = BlackOrWhite(cHoverColorSetByUser)
        If cFormSet = True Then Apply
    End Property
       
    Public Property Get DisplayCloseButton() As Boolean
        DisplayCloseButton = cDisplayCloseButton
    End Property
   
    Public Property Let DisplayCloseButton(uDisplayCloseButton As Boolean)
        cDisplayCloseButton = uDisplayCloseButton
        If cFormSet = True Then Apply
    End Property
   
    Public Property Set Form(uForm As Object)
        Set cForm = uForm
        Call AdjustControlsPos
        cCaption = IIf(cCaption = "Default", uForm.Caption, cCaption)
        Call IUnknown_GetWindow(cForm, VarPtr(hwnd))
        Apply
        cFormSet = True
    End Property
           
    ' Prepares userform / applies colors to controls
           
    Public Sub Apply()
       
        HideTitleBorder
       
        Dim cFormBackColor
       
        Call CreateShadow
       
        cFormBackColor = cForm.BackColor
       
        cTitleBarColor = IIf(cTitleBarColorSetByUser >= 0, cTitleBarColorSetByUser, cFormBackColor)
        cHoverColor = IIf(cHoverColorSetByUser >= 0, cHoverColorSetByUser, IIf(cTitleBarColorSetByUser >= 0, cTitleBarColorSetByUser, TintAndShade(cFormBackColor, -40)))
        cCaptionColor = BlackOrWhite(cTitleBarColor)
        cCaptionHoverColor = BlackOrWhite(cHoverColor)
       
        If NewTitleBar Is Nothing Then
            CreatePseudoTitleBar
        Else
            NewTitleBar.BackColor = cTitleBarColor
            NewTitleBarCaption.ForeColor = cCaptionColor
            NewCloseButton.BackColor = cTitleBarColor
        End If
       
    End Sub
 
    ' Creates the pseudo titlebar
 
    Private Sub CreatePseudoTitleBar()
        Set NewTitleBar = cForm.Controls.Add("Forms.Label.1", "lbTitleBar")
        With NewTitleBar
            .BackColor = cTitleBarColor
            .BackStyle = fmBackStyleOpaque
            .Left = 0
            .Top = 0
            .Height = 20
            .Width = cForm.InsideWidth - 26
        End With
       
        Set NewTitleBarCaption = cForm.Controls.Add("Forms.Label.1", "lbTitleBarCaption")
        With NewTitleBarCaption
            .BackStyle = fmBackStyleTransparent
            .Caption = cCaption
            .Font.Name = "Segoe UI"
            .Font.Size = 9
            .ForeColor = cCaptionColor
            .Left = 6
            .Top = 4
            .Height = 20
            .Width = cForm.InsideWidth - 26
            .AutoSize = True
        End With
       
        Set NewCloseButton = cForm.Controls.Add("Forms.Label.1", "lbCloseButton")
        With NewCloseButton
            .BackColor = cTitleBarColor
            .BackStyle = fmBackStyleOpaque
            .Height = 20
            .Width = 24
            .Left = cForm.InsideWidth - 26
            .Top = 0
            .PicturePosition = fmPicturePositionCenter
            .Picture = Application.CommandBars.GetImageMso("WindowClose", 16, 16)
        End With
       
        Set CancelBUtton = cForm.Controls.Add("Forms.CommandButton.1", "btnDefaultCancel")
        With CancelBUtton
            .TabStop = False
            .Cancel = True
            .Top = -40
        End With
        If cDisplayCloseButton = False Then NewCloseButton.Visible = False
     
   End Sub
 
   ' Events for dynamically created controls / pseudo titlebar
 
    Private Sub cForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
        If cFocusOnForm = False Then
            NewCloseButton.BackColor = cTitleBarColor
            NewTitleBar.BackColor = cTitleBarColor
            NewTitleBarCaption.ForeColor = cCaptionColor
            cFocusOnForm = True
        End If
    End Sub
   
    ' Close routine for the pseudo closebutton
   
    Private Sub NewCloseButton_Click()
        Unload cForm
    End Sub
   
    Private Sub NewCloseButton_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
        NewCloseButton.BackColor = vbRed
        cFocusOnCloseButton = True
    End Sub


    Private Sub NewTitleBarCaption_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
'        Debug.Print "Caption"
        If cFocusOnForm = True Then
            NewTitleBar.BackColor = cHoverColor
            NewCloseButton.BackColor = cHoverColor
            NewTitleBarCaption.ForeColor = cCaptionHoverColor
            cFocusOnForm = False
            cFocusOnCloseButton = False
        End If
        If Button Then
            MoveUserForm
        End If
    End Sub
   
    Private Sub NewTitleBar_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
'        Debug.Print "Titlebar"
        If cFocusOnForm = True Then
            NewTitleBar.BackColor = cHoverColor
            NewCloseButton.BackColor = cHoverColor
            NewTitleBarCaption.ForeColor = cCaptionHoverColor
            cFocusOnForm = False
            cFocusOnCloseButton = False
        End If
        If Button Then
            MoveUserForm
        End If
    End Sub
   
    ' Click event for the hidden command button that is dynamically-created
    ' with cancel property set to allow for easy use of escape key.
   
    Private Sub CancelButton_Click()
        Dim Handled As Boolean
        RaiseEvent CancelBUtton(Handled)
        If Handled = False Then
            Unload cForm
        End If
    End Sub
   
    ' Misc / Helper routines
   
    Private Sub HideTitleBorder()
        WindowStyle = GetWindowLong(hwnd, GWL_STYLE)
        WindowStyle = WindowStyle And (Not WS_CAPTION)
        SetWindowLong hwnd, GWL_STYLE, WindowStyle
        WindowStyle = GetWindowLong(hwnd, GWL_EXSTYLE)
        WindowStyle = WindowStyle And Not WS_EX_DLGMODALFRAME
        SetWindowLong hwnd, GWL_EXSTYLE, WindowStyle
        DrawMenuBar hwnd
    End Sub
   
    Private Sub MoveUserForm()
        ReleaseCapture
        SendMessage hwnd, WM_NCLBUTTONDOWN, HTCAPTION, ByVal 0&
    End Sub

    Private Function TintAndShade(ByVal ColRef As Long, Optional ByVal Luminance As Long = 0) As Long
        ' Orignally sourced code written by Jaafar Tribak from https://www.mrexcel.com/board/threads/applying-tintandshade-to-a-userform-label.1189219/
        '(Luminance must be between -100 and +100)
        OleTranslateColor ColRef, 0, ColRef
        TintAndShade = ColorAdjustLuma(ColRef, Luminance * 10, True)
    End Function

    Private Function BlackOrWhite(Color As Long) As Long
        Dim cRed As Long, cGreen As Long, cBlue As Long
        cRed = Color And 255
        cGreen = (Color \ 256) And 255
        cBlue = (Color \ 65536) And 255
        If cRed * 0.3 + cGreen * 0.59 + cBlue * 0.11 < 128 Then BlackOrWhite = vbWhite
    End Function
   
   
    Private Sub CreateShadow()
   
        Const SM_CYCAPTION = 4
        Const SM_CYDLGFRAME = 8
        Const RGN_OR = 2
        Const RGN_DIFF = 4
        Const COLOR_3DDKSHADOW = 21
        Const PS_SOLID = 1
   
        #If Win64 Then
            Dim hwnd As LongLong, hDC As LongLong, hPen As LongLong, hPrevPen As LongLong
            Dim hRgn1 As LongLong, hRgn2 As LongLong, hRgn3 As LongLong, hRgn4 As LongLong, hRgn5 As LongLong
        #Else
            Dim hwnd As Long, hDC As Long, hPen As Long, hPrevPen As Long
            Dim hRgn1 As Long, hRgn2 As Long, hRgn3 As Long, hRgn4 As Long, hRgn5 As Long
        #End If
       
        Dim tFormClientRect As RECT
        Dim lPenColor As Long, lPenWidth As Long
   
   
        Call IUnknown_GetWindow(cForm, VarPtr(hwnd))
        Call GetClientRect(hwnd, tFormClientRect)
        hDC = GetDC(hwnd)
        lPenWidth = 3
       
        With tFormClientRect
            hRgn1 = CreateRectRgn(.Left, .Top, .Right, .Bottom)
            hRgn2 = CreateRectRgn(.Left, .Top, .Right, GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CYDLGFRAME))
            Call CombineRgn(hRgn1, hRgn2, hRgn1, RGN_DIFF)
            Call DeleteObject(hRgn1)
            hRgn3 = CreateRectRgn(.Right - .Left - lPenWidth, .Top, .Right, 8)
            Call CombineRgn(hRgn2, hRgn2, hRgn3, RGN_DIFF)
            Call DeleteObject(hRgn3)
            hRgn4 = CreateRectRgn(.Left, GetSystemMetrics(SM_CYCAPTION), .Right, .Bottom)
            Call CombineRgn(hRgn2, hRgn2, hRgn4, RGN_OR)
            Call DeleteObject(hRgn4)
            hRgn5 = CreateRectRgn(.Left, .Bottom - lPenWidth, 8, .Bottom)
            Call CombineRgn(hRgn2, hRgn2, hRgn5, RGN_DIFF)
            Call DeleteObject(hRgn5)
            Call SetWindowRgn(hwnd, hRgn2, True)
            Call DeleteObject(hRgn2)
        End With
   
        DoEvents
        Call TranslateColor(GetSysColor(COLOR_3DDKSHADOW), 0, lPenColor)
        hPen = CreatePen(PS_SOLID, lPenWidth, lPenColor)
        hPrevPen = SelectObject(hDC, hPen)
        With tFormClientRect
            Call MoveToEx(hDC, .Right - 2, .Top + 8, ByVal 0)
            Call LineTo(hDC, .Right - 2, .Bottom - 2)
            Call LineTo(hDC, .Left + 8, .Bottom - 2)
        End With
   
        Call SelectObject(hDC, hPrevPen)
        Call DeleteObject(hPen)
        Call ReleaseDC(hwnd, hDC)
   
    End Sub
   
    Private Sub AdjustControlsPos()
        Const SM_CYCAPTION = 4
        Const SM_CYDLGFRAME = 8
        Dim oCtrl As Control
   
        For Each oCtrl In cForm.Controls
            If oCtrl.Parent Is cForm Then
                oCtrl.Top = oCtrl.Top + PXtoPT(GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CYDLGFRAME), True)
                'oCtrl.Left = oCtrl.Left + PXtoPT(GetSystemMetrics(5), False) + PXtoPT(GetSystemMetrics(32), False)
            End If
        Next oCtrl
    End Sub
   
    Private Function ScreenDPI(ByVal bVert As Boolean) As Long
        Const LOGPIXELSX As Long = 88
        Const LOGPIXELSY As Long = 90
        Static lDPI(1), hDC
   
        If lDPI(0) = 0 Then
            hDC = GetDC(0)
            lDPI(0) = GetDeviceCaps(hDC, LOGPIXELSX)
            lDPI(1) = GetDeviceCaps(hDC, LOGPIXELSY)
            hDC = ReleaseDC(0, hDC)
        End If
        ScreenDPI = lDPI(Abs(bVert))
    End Function
   
    Private Function PXtoPT(ByVal Pixels As Long, ByVal bVert As Boolean) As Single
        Const POINTSPERINCH As Long = 72
        PXtoPT = Pixels / (ScreenDPI(bVert) / POINTSPERINCH)
    End Function

PS:
I left out coding for the last userform. The one without the X close button. Hopefully, you should be able to easily amend the class code to take that scenario into account.