[Windows] Colorizing things...
Posted: Sun Feb 08, 2026 1:44 pm
Hi, creating a dark mode for windows programs seems to be a little bit tricky...
There are only few gadget types which can be colrized by using the purebasic function SetGadgetColor, all others needs callbacks. Adjusting the window caption is not a big deal (see here or second code below) but the status bar seems to be a problem...
...by using callbacks it seems to be necessary to disable the XP skinning - which does give a different look and feel and otherwise there is a sizing bix on the bottom right edge which stays visible in the default color.
What I actually do is to overlay an image gadget which needs to draw all fields manually - does anyone have a better solution?
PS: collectors for PB7.0 wishes may ask for additional or more complete coloring functions (SetWindowCaptionColor, StetStatusBarColor, SetComboBoxColor, SetCheckBoxColor, SetOptionColor, SetTrackColor,...)
Status bar code example (simplified demo):
Window caption source code (taken and modified from the link above):
There are only few gadget types which can be colrized by using the purebasic function SetGadgetColor, all others needs callbacks. Adjusting the window caption is not a big deal (see here or second code below) but the status bar seems to be a problem...
...by using callbacks it seems to be necessary to disable the XP skinning - which does give a different look and feel and otherwise there is a sizing bix on the bottom right edge which stays visible in the default color.
What I actually do is to overlay an image gadget which needs to draw all fields manually - does anyone have a better solution?
PS: collectors for PB7.0 wishes may ask for additional or more complete coloring functions (SetWindowCaptionColor, StetStatusBarColor, SetComboBoxColor, SetCheckBoxColor, SetOptionColor, SetTrackColor,...)
Status bar code example (simplified demo):
Code: Select all
; Define
EnableExplicit
#StatusBarRightSpace= 400
#StatusBarSystemFont= 0
Structure StatusType
Window.i
Status.i
Gadget.i
Image.i
Font.i
Width.i
Height.i
Color.i
Text.s
EndStructure
Global Bar.StatusType
; EndDefine
CompilerIf #StatusBarSystemFont
Procedure.s GetDefaultFontName()
Protected fnt=GetStockObject_(#DEFAULT_GUI_FONT)
Protected finfo.LOGFONT
Protected systemfontname.s
If fnt
GetObject_(fnt,SizeOf(LOGFONT),@finfo)
systemfontname=PeekS(@finfo\lfFaceName[0])
ProcedureReturn PeekS(@finfo\lfFaceName[0])
EndIf
ProcedureReturn "System"
EndProcedure
Procedure GetDefaultFontSize()
Protected fnt=GetStockObject_(#DEFAULT_GUI_FONT)
Protected finfo.LOGFONT
Protected systemfontsize
If fnt
GetObject_(fnt,SizeOf(LOGFONT),@finfo)
systemfontsize=finfo\lfHeight
ProcedureReturn finfo\lfHeight
EndIf
ProcedureReturn 12
EndProcedure
CompilerEndIf
Procedure InitSystemFont(win)
Protected hdc
Protected ncm.NONCLIENTMETRICS
With Bar
CompilerIf #StatusBarSystemFont
hdc=LoadFont(#PB_Any,GetDefaultFontName(),GetDefaultFontSize())
\Font=FontID(hdc)
CompilerElse
ncm\cbSize=SizeOf(NONCLIENTMETRICS)
SystemParametersInfo_(#SPI_GETNONCLIENTMETRICS, SizeOf(NONCLIENTMETRICS), @ncm, 0)
hdc=GetDC_(WindowID(win))
GetDeviceCaps_(hdc, #LOGPIXELSY)
ReleaseDC_(WindowID(win), hdc)
\Font=CreateFontIndirect_(@ncm\lfCaptionFont)
CompilerEndIf
EndWith
EndProcedure
Procedure InitStatusBar(win,status,gadget,image,color=#White)
With Bar
\Window= win
\Status= status
\Gadget= gadget
\Image= image
\Color= color
\Width= WindowWidth(win)+#StatusBarRightSpace
\Height= StatusBarHeight(status)
CreateImage(\Image,\Width,\Height,24,color)
ImageGadget(\Gadget,0,1,\Width,\Height,ImageID(\Image))
SetParent_(GadgetID(\Gadget),StatusBarID(\Status))
EndWith
EndProcedure
Procedure UpdateStatusBar()
Protected n
With Bar
n=WindowWidth(\Window)+#StatusBarRightSpace
If n<>\Width
\Width=n
\Height=StatusBarHeight(\Status)
CreateImage(\Image,\Width,\Height)
EndIf
StartDrawing(ImageOutput(\Image))
Box(0,0,\Width,\Height,\Color)
DrawingFont(\Font)
DrawText(10,3,"Test "+FormatDate("%hh:%ii:%ss",Date()),#Black,\Color)
Box(120,5,\Width-#StatusBarRightSpace-140,\Height-12,#Black)
Box(121,6,\Width-#StatusBarRightSpace-142,\Height-14,#White)
Box(122,7,Random(\Width-#StatusBarRightSpace-146),\Height-16,#Red)
StopDrawing()
SetGadgetState(\Gadget,ImageID(\Image))
EndWith
EndProcedure
Define quit
OpenWindow(0, 0,0, 340,100, "Colored Status Bar", #PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_SizeGadget|#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget)
CreateStatusBar(0,WindowID(0))
InitSystemFont(0)
InitStatusBar(0,0,0,0,#Yellow)
AddWindowTimer(0,0,250)
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
quit=#True
Case #PB_Event_Timer
UpdateStatusBar()
EndSelect
Until quit
CompilerIf #StatusBarSystemFont=#Null
DeleteObject_(Bar\Font)
CompilerEndIf
Code: Select all
;EnableExplicit
Enumeration DWMWINDOWATTRIBUTE
#DWMWA_USE_IMMERSIVE_DARK_MODE= 20
#DWMWA_BORDER_COLOR= 34
#DWMWA_CAPTION_COLOR= 35
#DWMWA_TEXT_COLOR= 36
EndEnumeration
PrototypeC.i DwmSetWindowAttribute(hwnd.i, dwAttribute.l, *pvAttribute, cbAttribute.l)
OpenWindow(0, 50, 50, 600, 400, "Colored Window", #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget|#PB_Window_SizeGadget)
OpenWindow(1, 700, 50, 600, 400, "DarkMode Window", #PB_Window_SystemMenu)
Procedure ColorTheme()
Protected DwmSetWindowAttribute.DwmSetWindowAttribute
Protected.l CaptionColor, TextColor, BorderColor
Protected.i UseDarkMode
UseDarkMode= Random(1)
CaptionColor= Random(#White)
TextColor = #Blue
BorderColor = #Red
If OpenLibrary(0, "dwmapi")
DwmSetWindowAttribute = GetFunction(0, "DwmSetWindowAttribute")
DwmSetWindowAttribute(WindowID(0), #DWMWA_USE_IMMERSIVE_DARK_MODE, @UseDarkMode, SizeOf(UseDarkMode))
DwmSetWindowAttribute(WindowID(0), #DWMWA_CAPTION_COLOR, @CaptionColor, SizeOf(CaptionColor))
;DwmSetWindowAttribute(WindowID(0), #DWMWA_TEXT_COLOR, @TextColor, SizeOf(TextColor))
;DwmSetWindowAttribute(WindowID(0), #DWMWA_BORDER_COLOR, @BorderColor, SizeOf(BorderColor))
DwmSetWindowAttribute(WindowID(1), #DWMWA_USE_IMMERSIVE_DARK_MODE, @UseDarkMode, SizeOf(UseDarkMode))
CloseLibrary(0)
EndIf
EndProcedure
AddWindowTimer(0,0,500)
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
End
Case #PB_Event_Timer
ColorTheme()
EndSelect
ForEver
