1 Attachment(s)
Windows 11 Dark Mode on VB6 app and controls - Progress
Hi everyone, I have been in extenssive chat with......well, with Windows 11's own helper, Copilot! This app saved me tons of hours of search on Google. My code is not yet finalized but I do intend to post the entirety of my findings and code on GitHub once I will have finished theming all of the basic VB6 controls (I have 1 VB6 app on GitHub right now which you can see here). Right now, I have most controls taken care of. Here's the screenshot of my progress so far.
Attachment 193714
As you can see, it looks VERY promissing. Issues I am running into and working on before releasing the source code:
- Checkboxes and Option Buttons have been taken care of because, well, VB6 hates being user friendly so no foreground color option in the interface for those which means I need to manually set the caption color. Problem, normal API calls DO NOT do the job so I had to rely on subclassing to make this happen, results, well, you see it, it works!!! Kind-of, yeah, I need to also detect the state (disabled or not) and apply the proper colors depending on that state.
- Scrollbars: This is a real pain. They have no option in VB6 to manage background color. One thing that even weirder is that the theming works on them for everything else EXCEPT the normal state. You will not see it in the screenshot BUT, if you click on the background to scroll, background color changes to the theme's color! So there again, thank's Microsoft for this super easy and no problem theming. (that's sarcasm for those who missed it)
- Textbox: While the textbox looks fine, the problem is that it has no rounded corners like the theme AND when you focus on it, it uses the standard light theme border color instead of your accent color, so there again, some more fun time with API calls and API drawing.
- Frame: Already partially resolved, I just need to figure out a way to know the exact RECT of the frame's caption to draw the caption the same way I do with Checkboxes and Option Buttons.
- Selected color: As you can see in the folders list box, the selected color is not the one of my theme, the dark theme uses another shade of grey with a border, that's up next to the task.
- Frame, PictureBox and Label borders: I am not to sure I will be doing anything with those, maybe an exception for the frame, I'm thinking about it.
- DropDown boxes and Drives List: There again, rounded corners and selected color is off so I need to find a way around it.
A few notes and thoughts:
Although I do mention rounded corners of textboxes and dropdown boxes, I still am wondering if I will be spending my time trying to get these to be exactly the same. The textbox I want to but the rest, not sure, this is still an old programming language abandonned by Microsoft and I think people should consider that there are a few draw backs if you ever program in VB6. I think that a big part of the job is done, I am pretty happy with what I am seeing right now, but I have spent wayyy too much time on this project, I've litterally spent more than 1 month scrapping Internet and talking with AI Copilot to try and figure this out BUT, once done, anyone should be able to simply copy the class and modules in their prohect and call just 1 function, yes, only 1 function which does it all. I call it on a timer which I enable after the app has loaded but it cann be called on the form_load event directly.
So I may not work all issues but I will be making sure that all captions are drawn at the right color and get that accent color working for the textbox as well as the proper selected background color. Note that this is just for darkmode because as I can see, light mode seams to work OK or at least look fine without tinkering on anything.
Do not hesitate to share your thoughts and comments! VB6 apps will get a facelift with this now!
Re: Windows 11 Dark Mode on VB6 app and controls - Progress
Re: Windows 11 Dark Mode on VB6 app and controls - Progress
I had not seen it, but I've seen that they have similar issues as mine which I am currently overcomming. Subclassing is now working fine and made simple using Collections. The tricky part is finding the correct Window colors in the theme. The title bar, for example, it take's it's color from the ReadingPane in the aero style and finding the right color that coresponds to the Button face color was a challenge because different apps use different colors so my reference was Windows Explorer. So I found where the colors are taken from, at least, the ReadingPane color, now I need to find the rest.
That other project uses Krool's ActiveX Controls, I'm using just the standard vanilla (basic) VB6 controls. They also don't mention about the selected item backcolor which is still blue on their project too. I also did manage to change the checkbox and option button colors so everything's on the way. The only thing I am wondering is how they got the Frame to have the proper caption color, maybe it's the Krool activeX that manages that differently.
Re: Windows 11 Dark Mode on VB6 app and controls - Progress
UPDATE:
I had forgotten the menus! So I added a menu, I will be covering the menus to support darkmode too.
I've also changed the background color of the PictureBox to reflect the tabs and the toolbar of Windows Explorer since Pictureboxes are usually a good way to manipulate the content and create different containers. I think they should not be the same color of as the Window.
I am also trying to figure out how to implement the dark mode on the frames because in the example provided by fafalone above, they seem to have the frames in darkmode so I'll try to figure out which element in the aero msstyle is being used to properly theme this.
I also have added a Subclass Unload sub which should cleanup the subclassing when the app is closing, just to be sure there's no leaks on that side.
Re: Windows 11 Dark Mode on VB6 app and controls - Progress
Quote:
Originally Posted by
avidichard
UPDATE:
I had forgotten the menus! So I added a menu, I will be covering the menus to support darkmode too.
I've also changed the background color of the PictureBox to reflect the tabs and the toolbar of Windows Explorer since Pictureboxes are usually a good way to manipulate the content and create different containers. I think they should not be the same color of as the Window.
I am also trying to figure out how to implement the dark mode on the frames because in the example provided by fafalone above, they seem to have the frames in darkmode so I'll try to figure out which element in the aero msstyle is being used to properly theme this.
I also have added a Subclass Unload sub which should cleanup the subclassing when the app is closing, just to be sure there's no leaks on that side.
Hi,
Good news!! Have some sample or source code for us ;)
Thanks for the job!
Re: Windows 11 Dark Mode on VB6 app and controls - Progress
Code Snipets from the project:
I suppose I could shell out a few things, the only problem is that nothing is definitive and can change or be optimized. Right now I'm in deep research and chat with Copilot, Google has not been very usefull except for a few things. So here are some of the main functions and subs that I use:
Code:
' These are all of my declarations, I'll probably cleanup once I figure out which ones are useless
' True and folse in long format for API calls requiring it
Public Const FALSE_LONG As Long = &H0
Public Const TRUE_LONG As Long = &H1
Private Const S_OK As Long = &H0
Private Const RGN_AND As Long = &H1
Private Const RGN_OR As Long = &H2
Private Const RGN_XOR As Long = &H3
Private Const RGN_DIFF As Long = &H4
Private Const RGN_COPY As Long = &H5
Private Const DWMWA_NCRENDERING_ENABLED As Long = 1
Private Const DWMWA_NCRENDERING_POLICY As Long = 2
Private Const DWMWA_TRANSITIONS_FORCEDISABLED As Long = 3
Private Const DWMWA_ALLOW_NCPAINT As Long = 4
Private Const DWMWA_CAPTION_BUTTON_BOUNDS As Long = 5
Private Const DWMWA_NONCLIENT_RTL_LAYOUT As Long = 6
Private Const DWMWA_FORCE_ICONIC_REPRESENTATION As Long = 7
Private Const DWMWA_FLIP3D_POLICY As Long = 8
Private Const DWMWA_EXTENDED_FRAME_BOUNDS As Long = 9
Private Const DWMWA_HAS_ICONIC_BITMAP As Long = 10
Private Const DWMWA_DISALLOW_PEEK As Long = 11
Private Const DWMWA_EXCLUDED_FROM_PEEK As Long = 12
Private Const DWMWA_USE_IMMERSIVE_DARK_MODE_PRE As Long = 19
Private Const DWMWA_USE_IMMERSIVE_DARK_MODE As Long = 20
Private Const DWMWA_WINDOW_CORNER_PREFERENCE As Long = 33
Private Const DWMWA_BORDER_COLOR As Long = 34
Private Const DWMWA_CAPTION_COLOR As Long = 35
Private Const DWMWA_TEXT_COLOR As Long = 36
Private Const DWMWCP_DEFAULT As Long = 0
Private Const DWMWCP_DONOTROUND As Long = 1
Private Const DWMWCP_ROUND As Long = 2
Private Const DWMWCP_ROUNDSMALL As Long = 3
Private Const DWMNCRP_USEWINDOWSTYLE As Long = 0
Private Const DWMNCRP_DISABLED As Long = 1
Private Const DWMNCRP_ENABLED As Long = 2
Private Const WCA_USEDARKMODECOLORS As Long = 26
Private Const DT_LEFT As Long = 0
Private Const DT_CENTER As Long = 1
Private Const DT_RIGHT As Long = 2
Private Const DT_VCENTER As Long = 4
Private Const DT_BOTTOM As Long = 8
Private Const DT_WORDBREAK As Long = 16
Private Const DT_SINGLELINE As Long = 32
Private Const TMT_COLOR As Long = 204
Private Const TMT_RECT As Long = 209
Private Const TMT_BACKGROUND As Long = 1602
Private Const TMT_WINDOWTEXT As Long = 1609
Private Const TMT_BTNTEXT As Long = 1619
Private Const TMT_TEXT As Long = 3201
Private Const TMT_MARGINS As Long = 3601
Private Const TMT_FILLCOLOR As Long = 3802
Private Const TMT_TEXTCOLOR As Long = 3803
Private Const TMT_TEXTBORDERCOLOR As Long = 3817
Private Const TMT_TEXTSHADOWCOLOR As Long = 3818
Private Const WM_CREATE As Long = &H1
Private Const WM_DESTROY As Long = &H2
Private Const WM_PAINT As Long = &HF
Private Const WM_ERASEBKGND As Long = &H14
Private Const WM_DRAWITEM As Long = &H2B
Private Const WM_GETFONT As Long = &H31
Private Const WM_NCCREATE As Long = &H81
Private Const WM_NCPAINT As Long = &H85
Private Const WM_CTLCOLORSCROLLBAR As Long = &H137
Private Const WM_PRINTCLIENT As Long = &H318
Private Const WM_USER As Long = &H400
Private Const TRANSPARENT As Long = 1
Private Const OPAQUE As Long = 2
' WS_EX
Private Const WS_EX_DLGMODALFRAME As Long = &H1
Private Const WS_EX_TOPMOST As Long = &H8
Private Const WS_EX_TRANSPARENT As Long = &H20
Private Const WS_EX_MDICHILD As Long = &H40
Private Const WS_EX_TOOLWINDOW As Long = &H80
Private Const WS_EX_WINDOWEDGE As Long = &H100
Private Const WS_EX_CLIENTEDGE As Long = &H200
Private Const WS_EX_STATICEDGE As Long = &H20000
Private Const WS_EX_APPWINDOW As Long = &H40000
Private Const WS_EX_LAYERED As Long = &H80000
' WS
Private Const WS_ACTIVECAPTION As Long = &H1
Private Const WS_OVERLAPPED As Long = &H0
Private Const WS_MAXIMIZEBOX As Long = &H10000
Private Const WS_MINIMIZEBOX As Long = &H20000
Private Const WS_THICKFRAME As Long = &H40000
Private Const WS_SYSMENU As Long = &H80000
Private Const WS_DLGFRAME As Long = &H400000
Private Const WS_BORDER As Long = &H800000
Private Const WS_CAPTION As Long = &HC00000
Private Const WS_MAXIMIZE As Long = &H1000000
Private Const WS_DISABLED As Long = &H8000000
Private Const WS_MINIMIZE As Long = &H20000000
Private Const WS_CHILD As Long = &H40000000
Private Const WS_VISIBLE As Long = &H10000000
Private Const WS_OVERLAPPEDWINDOW As Long = (WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)
' SWP
Private Const SWP_NOSIZE As Long = &H1
Private Const SWP_NOMOVE As Long = &H2
Private Const SWP_NOZORDER = &H4
Private Const SWP_FRAMECHANGED As Long = &H20
Private Const SWP_NOOWNERZORDER = &H200
' SW
Private Const SW_HIDE As Long = 0
Private Const SW_NORMAL As Long = 1
Private Const SW_SHOWNORMAL As Long = 1
Private Const SW_SHOWMINIMIZED As Long = 2
Private Const WW_MAXIMIZE As Long = 3
Private Const SW_SHOWMAXIMIZED As Long = 3
Private Const SW_SHOWNOACTIVATE As Long = 4
Private Const SW_SHOW As Long = 5
Private Const SW_MINIMIZE As Long = 6
Private Const SW_SHOWMINNOACTIVE As Long = 7
Private Const SW_SHOWNA As Long = 8
Private Const SW_RESTORE As Long = 9
Private Const SW_SHOWDEFAULT As Long = 10
Private Const SW_FORCEMINIMIZE As Long = 11
' GWL
Private Const GWL_WNDPROC As Long = (-4)
Private Const GWL_HINSTANCE = (-6)
Private Const GWL_ID As Long = (-12)
Private Const GWL_STYLE As Long = (-16)
Private Const GWL_EXSTYLE As Long = (-20)
' Theme class and app name prefixes AND special seperation characters
Public Const TC_DARK_PREFIX As String = "DarkMode"
Public Const TC_DARK_PREFIXU As String = TC_DARK_PREFIX & "_"
Public Const TC_SEP As String = "::"
' =================
' For setting theme
' SetWindowTheme
' =================
Public Const THEME_APP_CFD As String = "CFD"
Public Const THEME_APP_COMBOBOX As String = "Combobox"
Public Const THEME_APP_DARKMODE As String = "DarkMode"
Public Const THEME_APP_DWM_WINDOW As String = "DWMWindow"
Public Const THEME_APP_EXPLORER As String = "Explorer"
Public Const THEME_APP_IMMERSIVE_START As String = "ImmersiveStart"
Public Const THEME_APP_SCROLLBAR As String = "ScrollBar"
Public Const THEME_APP_TOOLBAR As String = "Toolbar"
Public Const THEME_APP_WINDOW As String = "Window"
Public Const THEME_APP_DARK_CFD As String = TC_DARK_PREFIXU & THEME_APP_CFD
Public Const THEME_APP_DARK_EXPLORER As String = TC_DARK_PREFIXU & THEME_APP_EXPLORER
Public Const THEME_APP_DARK_IMMERSIVE_START As String = TC_DARK_PREFIXU & THEME_APP_IMMERSIVE_START
' ========================
' For setting theme colors
' GetThemeColor
' ========================
' Theme class names
Public Const THEME_CLASS_EXPLORER_NAVPANE As String = "ExplorerNavPane"
Public Const THEME_CLASS_MENU As String = "Menu"
Public Const THEME_CLASS_READINGPANE As String = "ReadingPane"
Public Const THEME_CLASS_SCROLLBAR As String = "ScrollBar"
Public Const THEME_CLASS_TASKMANAGER As String = "TaskManager"
Public Const THEME_CLASS_TOOLBAR As String = "Toolbar"
Public Const THEME_CLASS_WINDOW As String = "Window"
' Dark mode colors
Public Const THEME_CLASS_DARK_EXPLORER_NAVPANE As String = TC_DARK_PREFIX & TC_SEP & THEME_CLASS_EXPLORER_NAVPANE ' Window Background Color as well as listview, file and folder views
Public Const THEME_CLASS_DARK_READINGPANE As String = TC_DARK_PREFIX & TC_SEP & THEME_CLASS_READINGPANE ' Window Caption (Title bar) Background Color
Public Const THEME_CLASS_DARK_SCROLLBAR As String = TC_DARK_PREFIX & TC_SEP & THEME_CLASS_SCROLLBAR ' Scrollbar class
Public Const THEME_CLASS_DARK_TASKMANAGER As String = TC_DARK_PREFIX & TC_SEP & THEME_CLASS_TASKMANAGER ' Scrollbar background color
Public Const THEME_CLASS_DARK_TOOLBAR As String = TC_DARK_PREFIX & TC_SEP & THEME_CLASS_TOOLBAR ' Text box background color
Public Const THEME_CLASS_DARK_TABS As String = THEME_APP_DARK_IMMERSIVE_START & TC_SEP & THEME_CLASS_MENU ' Tabs and picturebox backgrounds
' ============================
' Part IDs for fetching colors
' ============================
Public Const THEME_PART_WINDOW_CAPTION_BG As Long = 1
Public Const THEME_PART_POPUP_BG As Long = 9
Public Const THEME_PART_POPUP_ITEM As Long = 14
Public Const THEME_PART_SCROLLBAR_BG As Long = 42
' Type declarations
Private Type thColors
bg As Long ' Background
fg As Long ' Foreground (Text)
fgbrd As Long ' Foreground border
brd As Long ' Border
accent As Long ' Accent
End Type
Private Type thIDs
sClass As String ' Class
sSubClass As String ' Sub Class
lPart As Long ' Part
lState As Long ' State
lProp As Long ' Property
End Type
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type MARGINS
cxLeftWidth As Long
cxRightWidth As Long
cyTopHeight As Long
cyBottomHeight As Long
End Type
Private Type SIZE
cx As Long
cy As Long
End Type
Private Type DTTOPTS
dwSize As Long
dwFlags As Long
crText As Long
crBorder As Long
crShadow As Long
iTextShadowType As Long
ptShadowOffset As POINTAPI
iBorderSize As Long
iFontPropId As Long
iColorPropId As Long
iStateId As Long
fApplyOverlay As Long
iGlowSize As Long
pfnDrawTextCallback As Long
lParam As Long
End Type
Private Type PAINTSTRUCT
hDC As Long
fErase As Long
rcPaint As RECT
fRestore As Long
fIncUpdate As Long
rgbReserved As Long
End Type
' gdi32
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal nLeftRect As Long, ByVal nTopRect As Long, ByVal nRightRect As Long, ByVal nBottomRect As Long, ByVal nWidthEllipse As Long, ByVal nHeightEllipse 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 DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function Rectangle Lib "gdi32" (ByVal hDC As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function SetBkMode Lib "gdi32" (ByVal hDC As Long, ByVal mode As Long) As Long
Private Declare Function SetBkColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long
' user32
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hDC As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function CallWindowProcA Lib "user32" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function BeginPaint Lib "user32" (ByVal hWnd As Long, ByRef lpPaint As PAINTSTRUCT) As Long
Private Declare Function EndPaint Lib "user32" (ByVal hWnd As Long, ByRef lpPaint As PAINTSTRUCT) As Long
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hDC As Long, ByVal lpStr As String, ByVal nCount As Long, ByRef lpRect As RECT, ByVal wFormat As Long) As Long
Private Declare Function SendMessageA Lib "user32" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function GetWindowLongA Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function GetWindowTextA Lib "user32" (ByVal hWnd As Long, ByVal lpString As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowTextLengthA Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function GetMenu Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function SetWindowLongA Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long
' uxtheme
Private Declare Function OpenThemeData Lib "uxtheme" (ByVal hWnd As Long, ByVal pszClassList As Long) As Long
Private Declare Function CloseThemeData Lib "uxtheme" (ByVal hTheme As Long) As Long
Private Declare Function DrawThemeText Lib "uxtheme" (ByVal hTheme As Long, ByVal hDC As Long, ByVal iPartId As Long, ByVal iStateId As Long, ByVal pszText As String, ByVal cchText As Long, ByVal dwTextFlags As Long, _
ByVal dwTextFags2 As Long, ByRef pRect As RECT) As Long
Private Declare Function DrawThemeTextEx Lib "uxtheme" (ByVal hTheme As Long, ByVal hDC As Long, ByVal iPartId As Long, ByVal iStateId As Long, ByVal pszText As String, ByVal cchText As Long, ByVal dwTextFlags As Long, ByRef pRect As RECT, _
ByRef pOtions As DTTOPTS) As Long
Private Declare Function DrawThemeBackground Lib "uxtheme" (ByVal hTheme As Long, ByVal hDC As Long, ByVal iPartId As Long, ByVal iStateId As Long, ByRef pRect As RECT, ByRef pClipRect As Any) As Long
Private Declare Function GetThemeMargins Lib "uxtheme.dll" (ByVal hTheme As Long, ByVal hDC As Long, ByVal iPartId As Long, ByVal iStateId As Long, ByVal iPropId As Long, ByRef prc As RECT, ByRef pMargins As MARGINS) As Long
Private Declare Function GetThemePartSize Lib "uxtheme.dll" (ByVal hTheme As Long, ByVal hDC As Long, ByVal iPartId As Long, ByVal iStateId As Long, ByRef pRect As RECT, ByVal eSize As Integer, ByRef psz As SIZE) As Long
Private Declare Function GetThemeColor Lib "uxtheme" (ByVal hTheme As Long, ByVal iPartId As Long, ByVal iStateId As Long, ByVal iPropId As Long, ByRef pColor As Long) As Long
Private Declare Function SetWindowTheme Lib "uxtheme.dll" (ByVal hWnd As Long, ByVal pszSubAppName As Long, ByVal pszSubIdList As Long) As Long
' dwmapi
Private Declare Function DwmExtendFrameIntoClientArea Lib "dwmapi" (ByVal hWnd As Long, lpMargins As MARGINS) As Long
Private Declare Function DwmSetWindowAttribute Lib "dwmapi" (ByVal hWnd As Long, ByVal dwAttribute As Long, ByRef pvAttribute As Long, ByVal cbAttribute As Long) As Long
Public colWndProc As Collection
Private iSubClass As Integer
Code:
' Returns red "r", green "g" or blue "b" value of a long color OR returns the colors with ONLY the RGB values of the color "vbrgb"
' Example of vbrgb: If long color includes Alpha values or any other values, will ONLY return the RGB portion in long format without alpha
Private Function LONGtoRGB(ByVal lColor As Long, Optional ByVal sReturnVal As String = "vbrgb") As Long
Dim lRed As Long
Dim lGreen As Long
Dim lBlue As Long
Dim sHex As String
Dim lRetVal As Long
' No need to go through the entire R, G and B extraction process if all we need is the VB LONG value
If (LCase$(sReturnVal) = "vbrgb") Then
LONGtoRGB = lColor And &HFFFFFF
Exit Function
End If
sHex = Hex(lColor)
If (Len(sHex) < 8) Then sHex = sHex & String$(8 - Len(sHex), "0")
lRed = CLng("&H" & Right$(sHex, 2))
lGreen = CLng("&H" & Mid$(sHex, 5, 2))
lBlue = CLng("&H" & Mid$(sHex, 3, 2))
lRetVal = RGB(lRed, lGreen, lBlue)
If (LCase$(sReturnVal) = "r") Then lRetVal = lRed
If (LCase$(sReturnVal) = "g") Then lRetVal = lGreen
If (LCase$(sReturnVal) = "b") Then lRetVal = lBlue
LONGtoRGB = lRetVal
End Function
Code:
' Retrieves the object's form handle (will detect it even if it is nested in other containers)
Public Function GetFormHandle(ByVal oObject As Object) As Long
Dim lRet As Long
Dim oParent As Object
Set oParent = oObject.Parent
While Not (TypeOf oParent Is Form)
Set oParent = oParent.Parent
Wend
GetFormHandle = oParent.hWnd
End Function
Code:
' Returns true if dark mode is enabled
' Unfortunately, there's no real reliable way to detect this using simple API calls from DWM.
' The only reliable way is by reading from the registry.
Public Function DarkModeEnabled() As Boolean
Dim bRetVal As Boolean
Dim sRet As String
Dim sKey As String
Dim sRegPath As String
bRetVal = False
sRegPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Themes\Personalize"
sKey = "AppsUseLightTheme"
sRet = RegRead(HKEY_CURRENT_USER, sRegPath, sKey)
If (sRet = "0") Then bRetVal = True
DarkModeEnabled = bRetVal
End Function
Code:
' This is in a module of it's own, just the basics to read registry
Option Explicit
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegQueryValueExA Lib "advapi32.dll" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, source As Any, ByVal numBytes As Long)
Public Const HKEY_CLASSES_ROOT As Long = &H80000000
Public Const HKEY_CURRENT_USER As Long = &H80000001
Public Const HKEY_LOCAL_MACHINE As Long = &H80000002
Public Const HKEY_USERS As Long = &H80000003
Public Const HKEY_CURRENT_CONFIG As Long = &H80000005
Public Const REG_SZ As Long = 1
Public Const REG_DWORD As Long = 4
Private Const KEY_QUERY_VALUE As Long = 1
Private Const ERROR_MORE_DATA As Long = 234
' Read value from registry - Returns value in string format
Public Function RegRead(ByVal lhKey As Long, ByVal sPath As String, ByVal sSetting As String) As String
Dim hKey As Long
Dim lErrNum As Long
Dim lDataType As Long
Dim lLen As Long
Dim aData() As Byte
Dim sRetVal As String
Dim lRetVal As Long
RegOpenKeyEx lhKey, sPath, 0, KEY_QUERY_VALUE, hKey
lLen = 1024
ReDim aData(0 To lLen - 1)
lErrNum = RegQueryValueExA(hKey, sSetting, 0, lDataType, aData(0), lLen)
If (lErrNum = ERROR_MORE_DATA) Then
ReDim aData(0 To lLen - 1)
RegQueryValueExA hKey, sSetting, 0, lDataType, aData(0), lLen
End If
' String data type
If (lDataType = REG_SZ) Then
sRetVal = Space$(lLen - 1)
CopyMemory ByVal sRetVal, aData(0), lLen - 1
End If
' DWord data type
If (lDataType = REG_DWORD) Then
CopyMemory lRetVal, aData(0), 4
sRetVal = Format$(lRetVal)
End If
RegCloseKey hKey
RegRead = sRetVal
End Function
I'll paste more in another post here, I've exceeded the maximum limit of characters.
Re: Windows 11 Dark Mode on VB6 app and controls - Progress
Code:
Public Sub SetDarkTheme(ByVal oForm As Form)
Dim lhWnd As Long
Dim lhDC As Long
Dim lVal As Long
Dim oCtl As Control
' No need to set darkmode if darkmode is not enabled
If (DarkModeEnabled = False) Then Exit Sub
' Get handles both hWnd and hDC
lhWnd = oForm.hWnd
lhDC = GetWindowDC(lhWnd)
' Enable DarkMode
lVal = TRUE_LONG
DwmSetWindowAttribute lhWnd, DWMWA_USE_IMMERSIVE_DARK_MODE, lVal, LenB(lVal)
' Apply theme to form
SetObjectDarkTheme oForm
' Apply theme to all objects in the form
For Each oCtl In oForm.Controls
SetObjectDarkTheme oCtl
Next oCtl
End Sub
' Sets the theme of an object.
' Default used is "Explorer" (if empty) but you can define your own using the THEME_CLASS_ and THEME_APP_ variables
Public Sub SetObjectDarkTheme(ByVal oObject As Object, Optional ByVal sAppName As String = "", Optional ByVal sSubAppName As String = "")
Dim sRef As String
Dim lhWnd As Long
Dim sUsedAppName As String
Dim stAppName As String
Dim stSubApp As String
Dim lAppName As Long
Dim lSubApp As Long
Dim lVal As Long
Dim lErr As Long
Dim bSetTheme As Boolean ' Defines if we apply theme through API or not
Dim bIsForm As Boolean ' Defines if the current object is a form (true) or control (false)
Dim bHandleSet As Boolean ' If the handle has been manually set or not (default is false)
' If the object is a timer, just leave, no theming needed
If (TypeOf oObject Is Timer) Then Exit Sub
bSetTheme = True
bIsForm = False
bHandleSet = False
stAppName = sAppName
stSubApp = sSubAppName
' Set default Dark Mode Class Name
If (stAppName = "") Then stAppName = THEME_APP_DARK_EXPLORER
' Set Dark Mode colors depending on control type and redefine theme reference if needed
' Menu
If (TypeOf oObject Is Menu) Then
lhWnd = GetMenu(GetFormHandle(oObject))
bHandleSet = True
stAppName = THEME_APP_DARKMODE
SetObjectDarkModeColors oObject, True, False, False, "", -1, -1, lhWnd, False, False
End If
' Label
If (TypeOf oObject Is Label) Then
SetObjectDarkModeColors oObject, True, False, True
bSetTheme = False
End If
' Form
If (TypeOf oObject Is Form) Then
SetObjectDarkModeColors oObject
Exit Sub
End If
' Frame
If (TypeOf oObject Is Frame) Then
SetObjectDarkModeColors oObject
End If
' Picturebox
If (TypeOf oObject Is PictureBox) Then
SetObjectDarkModeColors oObject, True, False, False, THEME_CLASS_DARK_TABS, THEME_PART_POPUP_BG, THEME_PART_POPUP_ITEM
End If
If (TypeOf oObject Is CommandButton) Then SetObjectDarkModeColors oObject, False
' Textbox
If (TypeOf oObject Is TextBox) Then
RemoveBorder oObject
SetObjectDarkModeColors oObject
End If
' Checkbox and Option Button
If (TypeOf oObject Is CheckBox Or TypeOf oObject Is OptionButton) Then
'SetObjectDarkModeColors oObject, True, True
End If
' Scrollbars
If (TypeOf oObject Is VScrollBar Or TypeOf oObject Is HScrollBar) Then
SetObjectDarkModeColors oObject, False, True, False, "", -1, -1, 0, False, False, True, False
End If
' Combobox ans drives list
If (TypeOf oObject Is ComboBox Or TypeOf oObject Is DriveListBox) Then
stAppName = THEME_APP_DARK_CFD
SetObjectDarkModeColors oObject
End If
' Listbox, files and folders list
If (TypeOf oObject Is ListBox Or TypeOf oObject Is DirListBox Or TypeOf oObject Is FileListBox) Then
SetObjectDarkModeColors oObject, True, False, False, THEME_CLASS_DARK_EXPLORER_NAVPANE
RemoveBorder oObject
End If
' Set object's theme
If (bSetTheme) Then
If (bHandleSet = False) Then lhWnd = oObject.hWnd
SetWindowTheme lhWnd, StrPtr(stAppName), 0
End If
End Sub
' Set's an object's color's in dark mode if applicable
' ApplyForeground: If object has no foreground option, set this to false
' AltColorMethod: If object has no back and fore color options, set this to true
' Note of caution here, this will SubClass the object which will intercept the draw calls for that object.
' Usually, this is used on checkboxes, option buttons and scrollbars since they have their own weirdness to handle drawing.
' bNohWnd: Put this to true if the object has no Window Handle (usually for labels)
Public Sub SetObjectDarkModeColors(ByVal oObject As Object, Optional ByVal ApplyForeground As Boolean = True, Optional ByVal AltColorMethod As Boolean = False, Optional ByVal bNohWnd As Boolean = False, Optional ByVal OverideClass As String = "", _
Optional ByVal OveridePartBG As Long = -1, Optional ByVal OveridePartFG As Long = -1, Optional ByVal OverideHandle As Long = 0, Optional ByVal bHasBackColor As Boolean = True, Optional ByVal bHasForeColor As Boolean = True, _
Optional ByVal bDrawBG As Boolean = True, Optional ByVal bDrawFG As Boolean = True)
Dim lRet As Long
Dim lVal As Long
Dim sVal As String
Dim otCol As thColors ' Themed colors
Dim bgIDs As thIDs ' Background IDs
Dim fgids As thIDs ' Foreground IDs
Dim lbgColor As Long ' Current object's background color
Dim lfgColor As Long ' Current object's foreground color
Dim lhTheme As Long ' Theme handle
Dim lhWnd As Long
Dim lhDC As Long
Dim ltbgColor As Long ' Current Theme's background color in theme's long format (NOT VB format)
Dim ltfgColor As Long ' Current Theme's foreground color in theme's long format (NOT VB format)
Dim bApplyTheme As Boolean
'Do not apply theme yet
bApplyTheme = False
' Default theme class to use
bgIDs.sClass = THEME_CLASS_DARK_EXPLORER_NAVPANE
If (OveridePartBG < 0) Then bgIDs.lPart = 1 Else bgIDs.lPart = OveridePartBG
bgIDs.lProp = TMT_FILLCOLOR
fgids.sClass = bgIDs.sClass
If (OveridePartFG < 0) Then fgids.lPart = 1 Else fgids.lPart = OveridePartFG
fgids.lProp = TMT_TEXTCOLOR
' Set handle to 0 if object has no handle or get object's handle
If (bNohWnd) Then
lhWnd = 0
lhDC = 0
Else
If (OverideHandle <> 0) Then lhWnd = OverideHandle Else lhWnd = oObject.hWnd
lhDC = GetWindowDC(lhWnd)
End If
' Keep original color in memory in case we need to use the default
If (AltColorMethod = False) Then
If (bHasBackColor) Then lbgColor = oObject.BackColor
If (ApplyForeground And bHasForeColor) Then lfgColor = oObject.ForeColor
End If
' --------------------
' Set color references
' --------------------
' If the color is Buttonface
If (lbgColor = vbButtonFace) Then
' For DarkMode Title bar color and button face colors, the only place offering the
' Vanilla Windows color like Explorer and other popups is the Class Name "DarkMode::ReadingPane"
' Background color
bgIDs.sClass = THEME_CLASS_DARK_EXPLORER_NAVPANE
If (OveridePartBG < 0) Then bgIDs.lPart = 1
bgIDs.lState = 0
bgIDs.lProp = TMT_FILLCOLOR
' Text color
fgids.sClass = bgIDs.sClass
If (OveridePartFG < 0) Then fgids.lPart = 2
fgids.lState = 0
fgids.lProp = TMT_TEXTCOLOR
' Ready to apply theme
bApplyTheme = True
End If
' If the color is Window Background
If (lbgColor = vbWindowBackground) Then
' Background color
bgIDs.sClass = THEME_CLASS_DARK_TOOLBAR
If (OveridePartBG < 0) Then bgIDs.lPart = 0
bgIDs.lState = 0
bgIDs.lProp = TMT_FILLCOLOR
' Text color
fgids.sClass = bgIDs.sClass
If (OveridePartFG < 0) Then fgids.lPart = 0
fgids.lState = 0
fgids.lProp = TMT_TEXTCOLOR
' Ready to apply theme
bApplyTheme = True
End If
' If no theme data has been set, do not apply theme and exit sub
If (bApplyTheme = False And AltColorMethod = False) Then Exit Sub
' Set the class to the overide Class
If (OverideClass <> "") Then
bgIDs.sClass = OverideClass
fgids.sClass = bgIDs.sClass
End If
' Open theme, get the colors and close the theme
lhTheme = OpenThemeData(0, StrPtr(bgIDs.sClass))
GetThemeColor lhTheme, bgIDs.lPart, bgIDs.lState, bgIDs.lProp, ltbgColor
' Transform the theme's color LONG value into a VB readable long to apply to objects
otCol.bg = LONGtoRGB(ltbgColor)
' Get the theme's foreground color if applicable
If (ApplyForeground) Then
GetThemeColor lhTheme, fgids.lPart, fgids.lState, fgids.lProp, ltfgColor
otCol.fg = LONGtoRGB(ltfgColor)
End If
' Apply colors
If (AltColorMethod = False) Then
oObject.BackColor = otCol.bg
If (ApplyForeground And bHasForeColor) Then oObject.ForeColor = otCol.fg
Else
' Normally apply background color
If (bHasBackColor) Then oObject.BackColor = otCol.bg
' Apply foreground and background colors if applicable
If (ApplyForeground) Then
SubClassObject oObject, otCol.fg, otCol.bg, bDrawBG, True, OverideHandle
Else
SubClassObject oObject, otCol.fg, otCol.bg, bDrawBG, False, OverideHandle
End If
End If
ReleaseDC lhWnd, lhDC
' Close theme
CloseThemeData lhTheme
End Sub
' Manually draw the caption and background of the control. Usually, if you have to use this, that means that ordinary means don't work
' so background must also be drawn to hide the original text, if ever you REALLY need it, you can disable the background drawing but it is defaulted to true.
Private Sub DrawControl(ByVal lhWnd As Long, ByVal sCaption As String, ByVal lTextColor As Long, ByVal lBackColor As Long, Optional ByVal bDrawBack As Boolean = True, Optional ByVal bDrawCaption As Boolean = True)
Dim lhDC As Long
Dim oRect As RECT
Dim owRect As RECT
Dim oSize As SIZE
Dim oMargins As MARGINS
Dim lhTheme As Long
Dim lhFont As Long
Dim lhOldDFont As Long
Dim lhBrush As Long
lhDC = GetWindowDC(lhWnd)
GetClientRect lhWnd, owRect
' Get current font
If (bDrawCaption) Then
lhFont = SendMessageA(lhWnd, WM_GETFONT, 0, 0)
If (lhFont <> 0) Then lhOldDFont = SelectObject(lhDC, lhFont)
End If
' Open theme and get control's size
lhTheme = OpenThemeData(0, StrPtr("BUTTON"))
GetThemePartSize lhTheme, lhDC, 3, 1, oRect, 1, oSize
CloseThemeData lhTheme
' Define the rectangle for the caption area
If (bDrawCaption) Then oRect.Left = oSize.cx + 4 Else oRect.Left = 0
oRect.Top = 0
oRect.Right = owRect.Right
oRect.Bottom = owRect.Bottom
' Draw background if needed
If (bDrawBack) Then
lhBrush = CreateSolidBrush(lBackColor)
FillRect lhDC, oRect, lhBrush
DeleteObject lhBrush
End If
' Draw the caption
If (bDrawCaption) Then
' Set the text color and background mode
SetTextColor lhDC, lTextColor
SetBkMode lhDC, TRANSPARENT
' Draw the caption text
DrawText lhDC, sCaption, Len(sCaption), oRect, DT_LEFT Or DT_VCENTER Or DT_SINGLELINE
' Set to old font
If (lhFont <> 0) Then SelectObject lhDC, lhOldDFont
End If
' Release the device context
ReleaseDC lhWnd, lhDC
End Sub
Code:
' Manages the object subclassing for dark mode
' Default Text color is white and back color is black
' You can set these to any default colors you want but it is recommended to set these colors when you call this sub
Public Sub SubClassObject(ByVal oObject As Object, Optional ByVal lTextColor As Long = 16777215, Optional ByVal lBackColor As Long = 0, Optional ByVal bDrawBackColor As Boolean = True, Optional ByVal bHasCaption As Boolean = True, Optional ByVal OverideHandle As Long = 0)
Dim owProc As clsWinTheme
' Initialise subclassing if this is the first time running
If (iSubClass <> 255) Then
Set colWndProc = New Collection
iSubClass = 255
End If
Set owProc = New clsWinTheme
If (OverideHandle = 0) Then owProc.hWnd = oObject.hWnd Else owProc.hWnd = OverideHandle
owProc.lpPrevWndProc = SetWindowLongA(owProc.hWnd, GWL_WNDPROC, AddressOf ControlWinProc)
' Set the caption if object has one
If (bHasCaption) Then owProc.sCaption = oObject.Caption
owProc.bDrawBack = bDrawBackColor
owProc.lTextColor = lTextColor
owProc.lBackColor = lBackColor
owProc.bDrawCaption = bHasCaption
colWndProc.Add owProc, CStr(owProc.hWnd)
End Sub
' Captures the paint event of the subclassed object and draws the dark mode colors
Private Function ControlWinProc(ByVal lhWnd As Long, ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim owProc As clsWinTheme
Dim lPrevWinProc As Long
Dim bCapturePaint As Boolean
Set owProc = New clsWinTheme
On Error Resume Next
Set owProc = colWndProc(CStr(lhWnd))
On Error GoTo 0
' Make sure that the object is subclassed or else, proceed with normal events without medling with paint event
bCapturePaint = Not (owProc Is Nothing)
If (bCapturePaint) Then lPrevWinProc = owProc.lpPrevWndProc
' Capture background erase event and draw background only
If (lMsg = WM_ERASEBKGND And bCapturePaint And owProc.bDrawBack) Then
SetBkColor GetWindowDC(owProc.hWnd), owProc.lBackColor
DrawControl lhWnd, owProc.sCaption, owProc.lTextColor, owProc.lBackColor, owProc.bDrawBack, False
ControlWinProc = 1
Exit Function
End If
' Capture paint event and draw caption only
If (lMsg = WM_PAINT And bCapturePaint And owProc.bDrawCaption) Then
ControlWinProc = CallWindowProcA(lPrevWinProc, lhWnd, lMsg, wParam, lParam)
DrawControl lhWnd, owProc.sCaption, owProc.lTextColor, owProc.lBackColor, False, owProc.bDrawCaption
Exit Function
End If
' Handle other paint messages which are irrelevant
If (lMsg = WM_NCPAINT Or lMsg = WM_PRINTCLIENT) Then
'ControlWinProc = 0
'Exit Function
End If
Debug.Print Format$(lMsg)
' In the case of any other event, just proceed as usual
ControlWinProc = CallWindowProcA(lPrevWinProc, lhWnd, lMsg, wParam, lParam)
End Function
' Unload all of the subclassed objects
Public Sub UnloadSubclassedObjects()
Dim owProc As clsWinTheme
On Error Resume Next
For Each owProc In colWndProc
If (owProc.hWnd <> 0) Then SetWindowLongA owProc.hWnd, GWL_WNDPROC, owProc.lpPrevWndProc
Next owProc
Set colWndProc = Nothing
On Error GoTo 0
End Sub
Code:
' This is inside a Class because subclassing does not like public declared types
Option Explicit
Public hWnd As Long
Public lpPrevWndProc As Long
Public sCaption As String
Public lTextColor As Long
Public lBackColor As Long
Public bDrawBack As Boolean
Public bDrawCaption As Boolean
That's pretty much the core of the code, but as I said, I am testing so this is not yet finalized. But the codes provide the grounds of working on it. Right now I'm working on those frea*ing scrollbars, they're a real pain in the butt!!!
Re: Windows 11 Dark Mode on VB6 app and controls - Progress
That would be horrendous amount of code to switch to dark mode. I refuse to believe anything other than SetWindowTheme + DmwSetWindowAttribute API is needed to switch in and out of dark mode. Subclassing would be complete overkill so better leave dark mode not implemented.
If I’m wrong it would be sad state of affairs for Vb6 apps.
Re: Windows 11 Dark Mode on VB6 app and controls - Progress
Quote:
Originally Posted by
wqweto
That would be horrendous amount of code to switch to dark mode. I refuse to believe anything other than SetWindowTheme + DmwSetWindowAttribute API is needed to switch in and out of dark mode. Subclassing would be complete overkill so better leave dark mode not implemented.
If I’m wrong it would be sad state of affairs for Vb6 apps.
That is what we would expect. But I researched the subject a couple of years ago and no, it was only partially supported by the Windows API and people from other languages (like for example C++) had to add a lot of custom code to support dark mode.
At the time I decided to wait until it is more supported. It seems that it isn't still now.
1 Attachment(s)
Re: Windows 11 Dark Mode on VB6 app and controls - Progress
Quote:
Originally Posted by
wqweto
That would be horrendous amount of code to switch to dark mode. I refuse to believe anything other than SetWindowTheme + DmwSetWindowAttribute API is needed to switch in and out of dark mode. Subclassing would be complete overkill so better leave dark mode not implemented.
If I’m wrong it would be sad state of affairs for Vb6 apps.
To answer your question in 2 letters: NO
In 1 screenshot, here:
Attachment 193725
This is why I have decided to try and make this possible.
This also permits to open possibilities in VB6 that was once not very possible or hard to find. You can extract the accent colors, get the theme colors and a whole bunch of other things that are undocumented in the old API Guide.
To resume, the project aims to be little and require just 2 things (3 at max).
A module with 1 single function which will theme everything ina form, a class required for subclassing. That's it. As for the 3rd one, well, it's to read the registry because it's needed to detect if Dark Mode is used.
3 other files are included which are just standard things, one is the use common controls module, the other one is the manifest file included as a resource and the 3rd one is the form itself.
So yes, it is indeed a pain, but once I get it to work, it should be a valuable resource for lots of people. Even if MS abandonned VB6, it does not mean that it still is not good. Apps still work and people still program in that language for whatever reason is good for them so why not give it a small boost in time and make it look up to date with today's style?
For me, it's a lot of work, once I'm done, for you, it's 2-3 files to include in your project and 1 single call to do in the form_load event (Apply the theme) and 1 in the form_unload (unloading the subclasses).
Re: Windows 11 Dark Mode on VB6 app and controls - Progress
Wouldn't you need the specific theme, not just explorer? Like for edit controls:
<class name="DarkMode_CFD::Edit"/>
<class name="DarkMode_Explorer::Edit"/>
Re: Windows 11 Dark Mode on VB6 app and controls - Progress
Any chance I can talk you into sharing a zip of your project so I can play along with it too?
Re: Windows 11 Dark Mode on VB6 app and controls - Progress
Quote:
Originally Posted by
fafalone
Wouldn't you need the specific theme, not just explorer? Like for edit controls:
<class name="DarkMode_CFD::Edit"/>
<class name="DarkMode_Explorer::Edit"/>
As of Microsoft's documentation, only the Subclass is to be used when setting the theme which some call it, the app. As for the second parameter of semi-colon seperated list, I tend to think that those are the classes. But again, I am still working into understanding all of this because documentation is scattered everywhere in bits and pieces and in different languages, C, C++, C#, Python, etc... But to answer your question, no, we use the subclass name, that is, the text before the double colons "::".
Quote:
Originally Posted by
DrBobby
Any chance I can talk you into sharing a zip of your project so I can play along with it too?
I'm thinking about it, I just don't want to scatter an unfinished project and have plenty of people working on it and then posting it as their own. I've spent almost 2 months on this throughout my family life and numerous doctor visits and mediacal appointments. But I am not closed to the idea, just give me some time to think about it. Up to now, I have supplied almost all of my theming code which people can start playing with too and apply it in thewir own way in their app or in their testing VB6 app.
Re: Windows 11 Dark Mode on VB6 app and controls - Progress
Some updates of the project. Actually, life has been pretty busy but I managed to find 1 thing out and it's not that fun to implement.
FRAMES
In Visual Basic, frames act a little bit like a PictureBox with 2 noticible differences.
1. It can have a title/caption
2. It has an inner border/frame/edge or whatever else you may call it
PROBLEM
It seams that the darkmode does not have frames implemented or at least, I have not found any documentation about this. That means that the only real way to have a frame use darkmode in it's entirety is to draw the freaking frame AND title, yes, the title too. So this means I have to do the following:
1 - Find the corresponding color of the border in darkmode if available or use a color that is logical for that inner border
2 - Redraw the border by respecting the original VB positionning of that border, meaning, if it's 6 pixels in, then draw the border 6 pixels in from the actual frame border
3 - Draw the title, that, by itself, is not too complicated with one annoying thing, drawing text draws on top of the border making the text have a strike through it. SOOOO, draw a filled rectangle positioned where VB positions the title in the same color as the background color of the frame.
4 - Draw the title in the rectangle drawn in #3.
5 - Make sure that all elements in the frame are drawn ON TOP of the drawn inner-border and caption because, YES, VB permits you to position elements on top of the caption and inner-border and does not restrict the positioning inside the border. This may sound stupid but it's how the Vanilla VB does it so that's how it should be done.
I've seen lots of people out there just saying to position a PictureBox then add a transparent background label with a visible border and place another label on top with a background color and no border as the title. Yes, if it was a lazy project, it's very good but the point of this project is to make every Vanilla VB controls have their darkmode colors applied within their original context as if it was part of VB itself. So no tricky workarounds. I mean to make this as easy as possible with no weird tinkering. All one has to do is program their app, build their interface normally and call the WinEleven function which does all the magic to every control.
Things I cannot control are the square/blocky appearance of the controls, even though one could decide to draw those too, I think these may are not needed. The point is to use the color scheme not change the entire appearance. This is still a 32 bits app which I think has it's charms of having an old-school-ish look. I just think it should at least keep up to Windows' colors at least.
Anyways, hope you people are doing great.
Re: Windows 11 Dark Mode on VB6 app and controls - Progress
Hi, good job until now, the stupid VB-Thunder Frame-Control made problems since Visual Styles in Windows XP, so I would suggest forget about it. For grouping OptionButtons just use a PictureBox as a Panel. For a newer look maybe also try to replace the font "MS Sans Serif" it looks kind of outdated, the new font in Windows since windows 10 is "Segoe UI"
Re: Windows 11 Dark Mode on VB6 app and controls - Progress
Quote:
Originally Posted by
OlimilO
Hi, good job until now, the stupid VB-Thunder Frame-Control made problems since Visual Styles in Windows XP, so I would suggest forget about it. For grouping OptionButtons just use a PictureBox as a Panel. For a newer look maybe also try to replace the font "MS Sans Serif" it looks kind of outdated, the new font in Windows since windows 10 is "Segoe UI"
The point of this project is to let people use the difault vanilla VB controls without any workarounds. If people want to do the work arounds for themselves, they can. As for the font, TRUE, but, again, fonts can be changed within the VB control properties, so it's not necessary to include Segoe UI in the default dark mode theming. All I plan is to change the colors. The reste, programmers can change it themselves without any problems. BUT, you DO raise one point though, When drawing the titles, the correct font MUST be used and I believe that it uses the default fant that the control has been customized with so I don't think it's a problem on that end BUT it still worth testing to be sure.
Re: Windows 11 Dark Mode on VB6 app and controls - Progress
Oh that was not my intention. I just want you to give your your example project a the better look.
Re: Windows 11 Dark Mode on VB6 app and controls - Progress
Quote:
Originally Posted by
OlimilO
Oh that was not my intention. I just want you to give your your example project a the better look.
Oh! No problem. Well, I COULD give an option in the parameters of the function to use Windows' default font. Something like:
Code:
Public Function WinEleven (Byval UseWindowsDefaultFont as Boolean = false)
As for the visual styles, I still try to redraw them using standard Windows calls and use the default colors of Windows for darkmode. Yes it's teadious, but it still permits anyone to use the VB controls unlimited and free as in the old days but with the option of using darkmode on it if the user has it enabled. Thanks for the insights and your thoughts, VERY appreciated. :)
Re: Windows 11 Dark Mode on VB6 app and controls - Progress
Quote:
Originally Posted by
avidichard
. . .
3 - Draw the title, that, by itself, is not too complicated with one annoying thing, drawing text draws on top of the border making the text have a strike through it. SOOOO, draw a filled rectangle positioned where VB positions the title in the same color as the background color of the frame.
Don't you already draw option/checkbox captions this way?
I mean literally subclassing WM_PAINT, calling the original proc and then overriding the control's caption with FillRect and then painting the caption text again with white color?
cheers,
</wqw>
