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]

I have had the need to draw the X close button many times before but never occured to me to use this GetImageMso handy Method. Thank you.

You're very welcome. I note that you used the FaceID in your customised titlebar project, which hadn't occurred to me either.

1- Setting the CS_DROPSHADOW class style affects all userforms. The problem is removing the shadow (AND NOT CS_DROPSHADOW) upon closing the form doesn' seem to work. This will leave any subsequent userforms looking with a double frame (at least in win10) .

If I remember correctly,I worked around this issue before by drawing a frame around the userform instead of setting the GCL_STYLE but that involved more work.

This makes a lot of sense, thank you, and now that you mention it, that has happened to me, though I hadn't made the connection (bizarrely). I did originally have the drop shadow as a property, but decided just to include it as standard. I feel the userform looks odd without something to as act as a border/contrast, so I will give it some though. I think I know the frame method you're speaking of, so will find it and take a look. Thank you for the suggestion.

2- When you hide the titlebar you will probably need to offset any pre-existing controls down by SM_CYCAPTION.

Actually, after some search last night, I found this (credit goes to LeandroA) which I have slightly adapted for office (All undocumeted functions from the uxtheme.dll !!!)

That's an excellent point. My testing had only considered a blank userform and not one with controls in it already.

Thank you for code from Leandro (I always like learning about undocumented functions) - and as long as we are sharing links to our favourite Leandro code snippets (I'm an admirer of his work).... I've actually come across his Class Shadow project a month or so ago (and having seen it in action on a friend's version of VB6), I think it's amazing. I'm keen to look into seeing when or not the VB6->VBA converter I'm working on is up to the task of converting it, but I think I am a bit too optimistic on that front. It's perhaps a bit much for a single simple userform, but it's visually very impressive.

 

[abdelfattah]

@Jaafar Tribak

Do you mean if the user selects a different color theme from the Windows Settings while the userform is on display

I don't change any color theme from windows settings . the matter is relating for change userform color Regardless color theme from the Windows Settings .

 

[Dan_W]

just question , the code in OP just work in win 32bit?

I downloaded your file . impressive and big work ! your file is very useful

I hope to don't happen any error in the future . actually I don't test your codes in new file to see how works , just I tested your file .
if there is problem , I will inform you
thanks for this great work genuis

Thank you very much, and you're welcome.
I suspect it might be worth making some minor changes to the code - Jaafar has made some very useful observations that I ought to address. I will update the workbook, so please do let me know if you have any comments/observations, and if I'm able to, I will try and address those too!

 

[Jaafar Tribak]

@Jaafar Tribak does the last code works like Dan's code?

Dan_w's code is obviously more elaborate and very useful for anyone's future projects but if you just want to change the backcolor to that of the titlebar, the two codes in post#17 should work.

BTW, I assume you want this for Win10 ? I am not sure if the codes will also work on other platforms .

 

[abdelfattah]

@Jaafar Tribak

Dan_w's code is obviously more elaborate and very useful for anyone's future projects

I know . just I see you posted the code and curiosity how code works . actually I tested it whether changed back color for form or not this is what I got .

 

[Jaafar Tribak]

@abdelfattah

Are you using Windows10 ?

I think you haven't applied any theme color for titlebars and frames in Windows>Settings>Personalization>Colors.

This is for Color Settings . You will need to apply some theme color by ticking the last checkbox.

 

[Dan_W]

As you might have predicted, the moment I uploaded the workbook, I started to see issues with the code that I wanted/need to change. I have made most the changes, but I will hold off on posting an updated version for a short time in case there are any further comments/suggestions. In short:

• Changing the caption property of the userform after the styles have been applied instantly removes them, so I've added a Caption property that will update the caption of the pseudo titlebar rather than the real one.
• Repositioned existing controls - following @Jaafar Tribak's very helpful suggestion, the class will now loop through all controls of the Userform and offset them by the height of the titlebar, thus making it appear as though the layout/positioning of the controls are unchanged. I had a sudden flashback from read your GetMyUserform code, Jaafar, that I should make a point of checking that the parent of the control is not a frame, so thank you for that too!
• I have changed the DropShadow to an optional property, turned off by default and with an explanation as to its effects and suggesting that it not be used. I will give some thought to alternatives in the meantime (I may just draw a simple border around the userform instead).
• And several other adjustments/corrections - such as properly measuring the height of the titlebar and sizing the pseudotitlebar accordingly (SM_CYCAPTION).

As for the code to get the accent/titlebar color, I quite like Leandro's solution - but that's probably because they're new APIs to me and I like coming across new APIs, and these are undocumented functions. Will add it to my list of API declarations. But I am also happy to see that the accent is found in the registry (which, when I think about it , of course it is) because that means I can add it to my (small but effective) UI Theme collection to determine the users dark theme/light theme, etc settings for Office, which currently just consists of:

Enum UITHEME
    DARKGREY = 3
    BLACK = 4
    WHITE = 5
End Enum
Function GetUITheme()
    Dim RegPath As String
    RegPath = Replace("HKEY_CURRENT_USER\SOFTWARE\Microsoft\Office\%VERSION%\Common\UI Theme", "%VERSION%", Application.Version)
    On Error Resume Next
    GetUITheme = CreateObject("WScript.Shell").RegRead(RegPath)
End Function

@abdelfattah - Do please let me know if you have any comments!

 

[Jaafar Tribak]

@Dan_W

Good work.

I had a sudden flashback from read your GetMyUserform code, Jaafar, that I should make a point of checking that the parent of the control is not a frame

And\or a Multipage. ( TabStrip is ok)

Also, as you know, SM_CYCAPTION will return the caption height in Pixels, so some pixel to points conversion will be needed before offsetting the controls Top Property.

Calculating the UserForm frame\border thickness (SM_CXBORDER ,SM_CXFRAME,SM_CXDLGFRAME ) should probably be taken into consideration as well.

Also, with respect to the shadow, the workaround I used before , which worked quite nicely, wasn't adding a frame. Instead, I created window (button adequatly formatted) and stuck it behind the userform + a small offset to the right & bottom.

I would love to see a simpler shadow-making alternative though.

Private Sub CreateShadow()

    Const GWL_HWNDPARENT = (-8)
    Const WS_POPUP = &H80000000
    Const WS_VISIBLE = &H10000000
    Const WS_DISABLED = &H8000000
    Const SWP_NOSIZE = &H1
    Const SWP_NOACTIVATE = &H10
    Const SWP_DEFERERASE = &H2000
    Const SWP_NOREDRAW = &H8
    Const SWP_SHOWWINDOW = &H40
    Const WS_EX_NOACTIVATE = &H8000000
    Const WS_EX_TOOLWINDOW = &H80
    Const COLOR_BTNSHADOW = 16
    Const RGN_DIFF = 4

    #If Win64 Then
        Dim hRgn1 As LongLong, hRgn2 As LongLong, hDC As LongLong, hBrush As LongLong
    #Else
        Dim hRgn1 As Long, hRgn2 As Long, hDC As Long, hBrush As Long
    #End If

    Dim tFormRect As RECT, tRgnRect As RECT
    Dim lOffset As Long

    Call GetWindowRect(hwnd, tFormRect)
 
    lOffset = 2
    With tFormRect
        If IsWindow(hShadow) = 0 Then
            hShadow = CreateWindowEx(0 Or WS_EX_TOOLWINDOW Or WS_EX_NOACTIVATE, "BUTTON", vbNullString, _
                 WS_POPUP Or WS_DISABLED, 0, 0, .Right - .Left - (lOffset * 2), _
                .Bottom - .Top - (lOffset * 2), 0, 0, GetModuleHandle(vbNullString), 0)
            Call SetWindowLong(hShadow, GWL_HWNDPARENT, hwnd)
        End If
        Call SetRect(tRgnRect, 0, 0, .Right - .Left, .Bottom - .Top)
        hBrush = CreateSolidBrush(&H595959)
        hRgn1 = CreateRectRgn(0, 0, tRgnRect.Right, tRgnRect.Bottom)
        hRgn2 = CreateRectRgn(0, 0, tRgnRect.Right - (lOffset * 3), tRgnRect.Bottom - (lOffset * 3))
        Call CombineRgn(hRgn2, hRgn1, hRgn2, RGN_DIFF)
        hDC = GetDC(hShadow)
        Call SelectClipRgn(hDC, hRgn2)
        Call SetWindowRgn(hShadow, hRgn2, True)
    End With
 
    With tFormRect
        Call SetWindowPos(hShadow, hwnd, .Left + (lOffset * 3), .Top + (lOffset * 3), 0, 0, _
                SWP_NOACTIVATE Or SWP_DEFERERASE Or SWP_NOSIZE Or SWP_SHOWWINDOW)
        Call FillRect(hDC, tRgnRect, hBrush)
    End With
         
    Call DeleteObject(hBrush)
    Call DeleteObject(hRgn1)
    Call DeleteObject(hRgn2)
    Call ReleaseDC(hShadow, hDC)

End Sub

 

[Dan_W]

Thank you, Jaafar! This very helpful!

And\or a Multipage. ( TabStrip is ok)

Honestly, I never use either control, so that hadn't even occurred to me, so thank you for pointing that out.

Also, as you know, SM_CYCAPTION will return the caption height in Pixels, so some pixel to points conversion will be needed before offsetting the controls Top Property.

This was a lightbulb moment for me! I had adjusted everything (including the height of the pseudo titlebar) to match this (in pixels), and I'm looking at it thinking - "this looks a bit wrong somehow..." - sure enough, I had forgotten about px-to-pt... I will need to check after work, but that feels like it'll fix the titlebar now.

Calculating the UserForm frame\border thickness (SM_CXBORDER ,SM_CXFRAME,SM_CXDLGFRAME ) should probably be taken into consideration as well.

Even more things I hadn't considered (as you can tell from the code) - I'm very grateful for the feedback.

Your point about the (window) frame got me thinking about alternatives to the drop shadow, and so I've been experimenting with different ways to create a contrast between the the userform and other windows - one thing I tried was retaining the default border/frame (i.e., WS_EX_DLGMODALFRAME) rather than removing it with the titlebar, as I currently do in the code. Frankly, I'm not a fan of retaining it without the titlebar.

But continuing with the border idea, I thought about making a pseudo border with a variable width - which is something I've done in the longer version of this class I've been working on.

Personally, I like having it as an option, but it still feels too flat, so I was going to look for the code you referenced yesterday when I got home tonight but now I don't need to! Thank you for this - I'm looking forward to implementing your CreateShadow code. I'll look into updating it all this evening, and unless I hear anything further from @abdelfattah, should be able to get it done by tomorrow morning.

I will give some thought to another shadow. It's been suggested that one could use two userforms, the second one (the shadow) would sit beneath the first, would be dark grey, with opacity at 30%(?), offset slightly from the first. Which might look good, but I haven't given it much thought how it might work practically. The second would need to move perfectly in sync with the first... and for that, your project here would be perfect, but this would hardly "simpler" than your approach above, so...

 

[Jaafar Tribak]

@Dan_W

The second would need to move perfectly in sync with the first

When first creating the shadow window, restrict its clip region to be a couple of pixels only taken from the bottom and from the right (see CombineRgn ,CreateRectRgn and SetWindowRgn) . Then, in the userform _MouseMove event, make sure you pass the UserForm hwnd in the second hwndInsertAfter argument of the SetWindowPos api .