[Windows] Colorizing things...

Just starting out? Need help? Post your questions and find answers here.
User avatar
Michael Vogel
Addict
Addict
Posts: 2860
Joined: Thu Feb 09, 2006 11:27 pm
Contact:

[Windows] Colorizing things...

Post by Michael Vogel »

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):

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
Window caption source code (taken and modified from the link above):

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
User avatar
mk-soft
Always Here
Always Here
Posts: 6585
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: [Windows] Colorizing things...

Post by mk-soft »

I used to play around. But I'm not satisfied, because you probably can't get the background of the status bar. (Frame)
On the items already.

Code: Select all

;-TOP by mk-soft

#SB_SETBKCOLOR = $2001

Global Dim StatusText.s(3)
StatusText(0) = "Area 1"
StatusText(1) = "Area 2"
StatusText(2) = "Area 3"

Global LineColor = CreateSolidBrush_(#GRAY_BRUSH)
Global ColorBK = CreateSolidBrush_(#Blue)

Procedure WinCallback(hWnd, uMsg, wParam, lParam) 
  Protected field, *draw.DRAWITEMSTRUCT
  
  Select UMsg 
    Case #WM_DRAWITEM
      *draw = lParam
      If *draw\hwndItem = StatusBarID(0)
        Debug "DRAWITEM "
        ;FrameRect_(*draw\hdc, *draw\rcItem, LineColor)
        ;*draw\rcItem\left + 0
        ;*draw\rcItem\right - 0
        FillRect_(*draw\hdc, *draw\rcItem, ColorBk)
        SetBkMode_(*draw\hDC,#TRANSPARENT)
        SetTextColor_(*draw\hdc, #Yellow)
        format = #DT_VCENTER | #DT_SINGLELINE | #DT_END_ELLIPSIS
        *draw\rcItem\left + 2
        *draw\rcItem\right - 2
        len = Len(StatusText(*draw\itemID))
        DrawText_(*draw\hdc, @StatusText(*draw\itemID), len, *draw\rcItem, format)
      EndIf
      
    Case #WM_PAINT
      Debug "#WM_PAINT"
      If hWnd = StatusBarID(0)
        Debug "Status"
      EndIf
  EndSelect 
  ProcedureReturn #PB_ProcessPureBasicEvents 
EndProcedure 

If OpenWindow(0, 100, 150, 300, 100, "PureBasic - StatusBar Example", #PB_Window_SystemMenu | #PB_Window_SizeGadget)
  
  If CreateStatusBar(0, WindowID(0))
    AddStatusBarField(100)
    AddStatusBarField(50)
    AddStatusBarField(100)
    AddStatusBarField(#PB_Ignore)
  EndIf
  
  ;StatusBarText(0, 0, "Area 1")
  ;StatusBarText(0, 1, "Area 2")
  ;StatusBarText(0, 2, "Area 3")
  
  SetWindowCallback(@WinCallback(), 0) 
  
  hStatus = StatusBarID(0)
  ;SendMessage_(hStatus, #SB_SIMPLE, #False, 0)
  ;SendMessage_(hStatus, #SB_SETBKCOLOR, 0, RGB(0, 0, 0));
  SendMessage_(hStatus, #SB_SETTEXT, #SBT_NOBORDERS | #SBT_OWNERDRAW | 0, 0) ; <- lParam is a 32 bit value for ItemData
  SendMessage_(hStatus, #SB_SETTEXT, #SBT_NOBORDERS | #SBT_OWNERDRAW | 1, 0)
  SendMessage_(hStatus, #SB_SETTEXT, #SBT_NOBORDERS | #SBT_OWNERDRAW | 2, 0)
  SendMessage_(hStatus, #SB_SETTEXT, #SBT_NOBORDERS | #SBT_OWNERDRAW | 3, 0)
  Repeat
  Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf
My Projects EventDesigner V3 / ThreadToGUI / OOP-BaseClass / Windows: Module ActiveScript
PB v3.30 / v5.75 - OS Mac Mini - VM Window Pro / Linux Ubuntu
Downloads on my OneDrive
breeze4me
Enthusiast
Enthusiast
Posts: 672
Joined: Thu Mar 09, 2006 9:24 am
Location: S. Kor

Re: [Windows] Colorizing things...

Post by breeze4me »

If it's just dark mode rather than coloring, you can do it as shown below.
The dark theme part of the statusbar likely isn't present in all builds of Windows 10, but it should be included starting from the first Windows 10 build that supported Explorer's dark theme, though I'm not sure which specific build that was.

Code: Select all

Define quit

OpenWindow(0, 0,0, 400,100, "Colored Status Bar", #PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_SizeGadget|#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget)
If CreateStatusBar(0, WindowID(0))
  AddStatusBarField(90)
  AddStatusBarField(100)
  AddStatusBarField(#PB_Ignore) ; automatically resize this field
  AddStatusBarField(100)
  
  StatusBarProgress(0, 1, 0)
  
  StatusBarText(0, 0, "Area normal")
  StatusBarText(0, 2, "Area right", #PB_StatusBar_Right) 
  StatusBarText(0, 3, "Area centered", #PB_StatusBar_Center)
  
  SetWindowTheme_(StatusBarID(0), 0, "DarkMode::ExplorerStatusBar")
  hProgress = GetWindow_(StatusBarID(0), #GW_CHILD)
  If hProgress
    SetWindowTheme_(hProgress, 0, "")
    
    #PBM_SETBARCOLOR = 1033
    #PBM_SETBKCOLOR = 8193
    
    SendMessage_(hProgress, #PBM_SETBARCOLOR, 0, #Blue)
    SendMessage_(hProgress, #PBM_SETBKCOLOR, 0, #Gray)
  EndIf
EndIf

AddWindowTimer(0, 0, 500)
Repeat
  Select WaitWindowEvent()
    Case #PB_Event_Timer
      StatusBarProgress(0, 1, i)
       i + 10
    Case #PB_Event_CloseWindow
      quit=#True
      
  EndSelect
Until quit
User avatar
mk-soft
Always Here
Always Here
Posts: 6585
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: [Windows] Colorizing things...

Post by mk-soft »

Where did you find that? Even with Google no hit DarkMode Statusbar

Code: Select all

 SetWindowTheme_(StatusBarID(0), 0, "DarkMode::ExplorerStatusBar")
My Projects EventDesigner V3 / ThreadToGUI / OOP-BaseClass / Windows: Module ActiveScript
PB v3.30 / v5.75 - OS Mac Mini - VM Window Pro / Linux Ubuntu
Downloads on my OneDrive
breeze4me
Enthusiast
Enthusiast
Posts: 672
Joined: Thu Mar 09, 2006 9:24 am
Location: S. Kor

Re: [Windows] Colorizing things...

Post by breeze4me »

mk-soft wrote: Mon Feb 09, 2026 11:42 am Where did you find that?
You can see this by opening the aero.msstyles file using msstyleEditor. (https://github.com/nptr/msstyleEditor)
User avatar
Michael Vogel
Addict
Addict
Posts: 2860
Joined: Thu Feb 09, 2006 11:27 pm
Contact:

Re: [Windows] Colorizing things...

Post by Michael Vogel »

Thanks, that's a good one - but only when doing dark mode only...

I'd need full colors...

Code: Select all

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)
CreateStatusBar(0, WindowID(0))
AddStatusBarField(90)
AddStatusBarField(100)
AddStatusBarField(#PB_Ignore) ; automatically resize this field
AddStatusBarField(100)

StatusBarProgress(0, 1,50)

Macro MixColors(ColA,ColB)
	( ((((ColB&$FF00)+(ColA&$FF00))>>1)&$FF00) | ((((ColB&$FF00FF)+(ColA&$FF00FF))>>1)&$FF00FF) )
EndMacro

Procedure ColorTheme()

	Protected DwmSetWindowAttribute.DwmSetWindowAttribute
	Protected.l CaptionColor, TextColor, BorderColor
	Protected.i UseDarkMode

	CaptionColor=	Random(#White)
	TextColor = #Blue
	BorderColor = #Red

	SetWindowTheme_(StatusBarID(0), 0, "DarkMode::ExplorerStatusBar")
	hProgress = GetWindow_(StatusBarID(0), #GW_CHILD)
	If hProgress
		SetWindowTheme_(hProgress, 0, "")
		#PBM_SETBARCOLOR = 1033
		#PBM_SETBKCOLOR = 8193
		SendMessage_(hProgress, #PBM_SETBARCOLOR, 0, #Blue)
		SendMessage_(hProgress, #PBM_SETBKCOLOR, 0, #Gray)
	EndIf
	
	SetWindowColor(0,MixColors(#White,CaptionColor))
	
	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))
		CloseLibrary(0)
	EndIf

EndProcedure

AddWindowTimer(0,0,500)
Repeat
	Select WaitWindowEvent()
	Case #PB_Event_CloseWindow
		End
	Case #PB_Event_Timer
		ColorTheme()
	EndSelect
ForEver
User avatar
mk-soft
Always Here
Always Here
Posts: 6585
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: [Windows] Colorizing things...

Post by mk-soft »

My gimmick maybe not for nothing ...

Canvas StatusBar

Code: Select all

;-TOP by mk-soft, v1.02.1, 09.02.2026

; ----

Structure udtStatusBarField
  Text.s
  Width.i
  colorText.l
  colorBackground.l
EndStructure

Structure udtStatusBar
  Gadget.i
  Font.i
  colorText.l
  colorBackground.l
  colorLine.l
  List Field.udtStatusBarField()
EndStructure

; ----

CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
  Procedure NSColorByNameToRGB(NSColorName.s, CalculateAlpha = #True)
    Protected.cgfloat red, green, blue, alpha
    Protected nscolorspace, rgb
    nscolorspace = CocoaMessage(0, CocoaMessage(0, 0, "NSColor " + NSColorName), "colorUsingColorSpaceName:$", @"NSCalibratedRGBColorSpace")
    If nscolorspace
      CocoaMessage(@red, nscolorspace, "redComponent")
      CocoaMessage(@green, nscolorspace, "greenComponent")
      CocoaMessage(@blue, nscolorspace, "blueComponent")
      If CalculateAlpha
        CocoaMessage(@alpha, nscolorspace, "alphaComponent")
        rgb = RGB(red * 255.0 * alpha, green * 255.0 * alpha, blue * 255.0 * alpha)
      Else
        rgb = RGB(red * 255.0, green * 255.0, blue * 255.0)
      EndIf
      ProcedureReturn rgb
    EndIf
  EndProcedure
CompilerEndIf

; ----

Declare DrawStatusBar(*StatusBar.udtStatusBar)

; ----

Procedure InitStatusBar(CanvasGadget, DarkMode = #False)
  Protected *StatusBar.udtStatusBar, font
  ; Init StatusBar Data
  
  With *StatusBar
    *StatusBar = AllocateStructure(udtStatusBar)
    If *StatusBar
      \Gadget = CanvasGadget
      CompilerSelect #PB_Compiler_OS
        CompilerCase #PB_OS_MacOS
          \font = LoadFont(#PB_Any,"",12)
          \colorText = NSColorByNameToRGB("controlTextColor")
          \colorBackground = NSColorByNameToRGB("controlColor")
          \colorLine = #Gray ; NSColorByNameToRGB("controlTextColor")
        CompilerCase #PB_OS_Windows
          \font = LoadFont(#PB_Any,"Tahoma",9)
          If DarkMode
            \colorText = $00FFFFFF
            \colorBackground = $002E2E2E
            \colorLine = #Gray
          Else
            \colorText = $00000000
            \colorBackground = $00E5E5E5
            \colorLine = #Gray
          EndIf
        CompilerCase #PB_OS_Linux
          Protected *Style.GtkStyle
          \font = LoadFont(#PB_Any,"Sans Serif",9)
          *Style.GtkStyle = gtk_widget_get_style_(GadgetID(\Gadget))
          \colorText = RGB(*Style\text[#GTK_STATE_NORMAL]\red >> 8, *Style\text[#GTK_STATE_NORMAL]\green >> 8, *Style\text[#GTK_STATE_NORMAL]\blue >> 8)
          \colorBackground = RGB(*Style\bg[#GTK_STATE_NORMAL]\red >> 8, *Style\bg[#GTK_STATE_NORMAL]\green >> 8, *Style\bg[#GTK_STATE_NORMAL]\blue >> 8)
          \colorLine = #Gray
      CompilerEndSelect
    EndIf
  EndWith
  ProcedureReturn *StatusBar
EndProcedure

Macro FreeStatusBarEx(StatusBar)
  If StatusBar : FreeStructure(StatusBar) : StatusBar = 0 : EndIf
EndMacro

Procedure AddStatusBarFieldEx(*StatusBar.udtStatusBar, Width, Text.s, TextColor.l = #PB_Default, BackColor.l = #PB_Default)
  With *StatusBar
    If *StatusBar
      AddElement(\Field())
      \Field()\Width = Width
      \Field()\Text = Text
      \Field()\colorText = TextColor
      \Field()\colorBackground = BackColor
    EndIf
  EndWith
EndProcedure

Procedure SetStatusBarText(*StatusBar.udtStatusBar, Field, Text.s)
  With *StatusBar
    If *StatusBar
      If Field >= ListSize(\Field())
        ProcedureReturn 0
      EndIf
      SelectElement(\Field(), Field)
      \Field()\Text = Text
      DrawStatusBar(*StatusBar)
    EndIf
  EndWith
EndProcedure
    
Procedure SetStatusBarColor(*StatusBar.udtStatusBar, Field, Typ, Color.l)
  With *StatusBar
    If *StatusBar
      If Field >= ListSize(\Field())
        ProcedureReturn 0
      EndIf
      If Field >= 0
        SelectElement(\Field(), Field)
        Select Typ
          Case #PB_Gadget_FrontColor
            \Field()\colorText = Color
          Case #PB_Gadget_BackColor
            \Field()\colorBackground = Color
        EndSelect
      Else
        Select Typ
          Case #PB_Gadget_FrontColor
            \colorText = Color
          Case #PB_Gadget_BackColor
            \colorBackground = Color
        EndSelect
      EndIf  
      DrawStatusBar(*StatusBar)
    EndIf
  EndWith
EndProcedure

Procedure DrawStatusBar(*StatusBar.udtStatusBar)
  Protected x.d, y.d, dx.d, dy.d, font_height, colorText.l, colorBackground.l
  
  With *StatusBar
    If *StatusBar
      dx = DesktopScaledX(GadgetWidth(\Gadget))
      dy = DesktopScaledY(GadgetHeight(\Gadget))
      StartDrawing(CanvasOutput(\Gadget))
      Box(0, 0, dx, dy, \colorBackground)
      Line(0, 0, dx, 1, \colorLine)
      DrawingFont(FontID(\Font))
      font_height = TextHeight("X")
      x = 0
      ForEach \Field()
        If \Field()\colorText = #PB_Default
          colorText = \colorText
        Else
          colorText = \Field()\colorText
        EndIf
        If \Field()\colorBackground = #PB_Default
          colorBackground = \colorBackground
        Else
          colorBackground = \Field()\colorBackground
          If \Field()\Width <> #PB_Ignore
            Box(x+1, 1, \Field()\Width-1, dy-1, colorBackground)
          Else
            Box(x+1, 1, dx - \Field()\Width, dy-1, colorBackground)
          EndIf
        EndIf
        DrawText(DesktopScaledX(x + 4), (dy - font_height) / 2.0, \Field()\Text, colorText, colorBackground)
        x + \Field()\Width
        If \Field()\Width <> #PB_Ignore
          Line(DesktopScaledX(x), 0, 1 , dy, \colorLine)
        EndIf
      Next
      StopDrawing()
    EndIf
  EndWith
EndProcedure

; ********

Enumeration FormWindow
  #Main
EndEnumeration

Enumeration FormGadgets
  #CANVAS
EndEnumeration

Enumeration Fonts
  #FontStatus
EndEnumeration

Global *StatusBar1

; ----

Procedure UpdateWindow()
  Protected dx, dy
  dx = WindowWidth(#Main) 
  dy = WindowHeight(#Main)
  ResizeGadget(#CANVAS, 0, dy-24, dx, 24)
  DrawStatusBar(*StatusBar1)
EndProcedure

; ----

;- Main

If OpenWindow(#Main, #PB_Ignore, #PB_Ignore, 640, 480, "PB Custom StatusBar", #PB_Window_SystemMenu|#PB_Window_SizeGadget)
  CanvasGadget(#CANVAS,0,WindowHeight(#Main)-24, WindowWidth(#Main),24 )
  
  *StatusBar1 = InitStatusBar(#CANVAS)
  AddStatusBarFieldEx(*StatusBar1, 100, "Status")
  AddStatusBarFieldEx(*StatusBar1, 220, "Hello World", #Yellow, #Blue)
  AddStatusBarFieldEx(*StatusBar1, #PB_Ignore, "Last Field")
  DrawStatusBar(*StatusBar1)
  
  SetStatusBarColor(*StatusBar1, -1, #PB_Gadget_FrontColor, #Black)
  SetStatusBarColor(*StatusBar1, -1, #PB_Gadget_BackColor, $EE861C)
  
  SetStatusBarColor(*StatusBar1, 2, #PB_Gadget_FrontColor, #Yellow)
  
  ;FreeStatusBarEx(*StatusBar1)
  
  BindEvent(#PB_Event_SizeWindow, @UpdateWindow(), #Main)
  
  Repeat
    Event = WaitWindowEvent()
    Select Event
      Case #PB_Event_CloseWindow
        Break
    EndSelect
  ForEver
EndIf

End
My Projects EventDesigner V3 / ThreadToGUI / OOP-BaseClass / Windows: Module ActiveScript
PB v3.30 / v5.75 - OS Mac Mini - VM Window Pro / Linux Ubuntu
Downloads on my OneDrive
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 5038
Joined: Sun Apr 12, 2009 6:27 am

Re: [Windows] Colorizing things...

Post by RASHAD »

In my opinion 50 line of code is enough

Code: Select all

LoadFont(0,"Georgia",16,#PB_Font_Bold | #PB_Font_Italic )
Global cont

Procedure statusCB()
  ResizeGadget(cont,1,1,WindowWidth(0),32)
EndProcedure

If OpenWindow(0, 0, 0, 800, 600, "PureBasic - StatusBar Example", #PB_Window_SystemMenu | #PB_Window_ScreenCentered| #PB_Window_SizeGadget)
  
  If CreateStatusBar(0, WindowID(0))
    AddStatusBarField(798 )
  EndIf
  sbHwnd = StatusBarID(0)
  SendMessage_(sbHwnd, #SB_SETMINHEIGHT, 32, 0)
  SendMessage_(sbHwnd, #WM_SIZE, 0,0)
  UseGadgetList(sbHwnd)
  cont = ContainerGadget(#PB_Any,1,1,800,32,#PB_Container_BorderLess)
  SetGadgetColor(cont,#PB_Gadget_BackColor,$0)
  Safield1 = TextGadget(#PB_Any,0,0,200,32," Test 4 Status",#SS_CENTER|#SS_CENTERIMAGE)
  GadgetToolTip(Safield1," Current Status ")
  SetGadgetColor(Safield1,#PB_Gadget_BackColor,$CCFEFC)
  SetGadgetColor(Safield1,#PB_Gadget_FrontColor,$0000FF)
  SetGadgetFont(Safield1,FontID(0))
  Safield2 = TrackBarGadget(#PB_Any,200,0,150,32,0,100)    
  Safield3 = StringGadget(#PB_Any,350,0,200,30,"TEST",#PB_String_BorderLess |#SS_CENTER|#SS_CENTERIMAGE)
  SetGadgetColor(Safield3,#PB_Gadget_BackColor,$0)
  SetGadgetColor(Safield3,#PB_Gadget_FrontColor,$FFFFFF)
  CloseGadgetList()
  UseGadgetList(WindowID(0))
  ButtonGadget(10,10,10,80,24,"RUN")
  BindEvent(#PB_Event_SizeWindow,@statusCB())
  Repeat   
    Select WaitWindowEvent()
      Case #PB_Event_CloseWindow
        Quit = 1
        
      Case #PB_Event_Gadget
        Select EventGadget()          
          Case 10
            Debug GetGadgetState(Safield2)
            SetGadgetText(Safield1,"New Text")
        EndSelect
        
    EndSelect
  Until Quit = 1
  
EndIf 
Egypt my love
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 5038
Joined: Sun Apr 12, 2009 6:27 am

Re: [Windows] Colorizing things...

Post by RASHAD »

Set any color you like for BackGround
Need to change the color for the grasp area as well
Have fun

Code: Select all

#SB_SETBKCOLOR = $2001

If OpenWindow(0, 100, 150, 300, 100, "PureBasic - StatusBar Example", #PB_Window_SystemMenu | #PB_Window_SizeGadget)

  If CreateStatusBar(0, WindowID(0))
    AddStatusBarField(100)
    AddStatusBarField(150)
    AddStatusBarField(150)
  EndIf

  StatusBarText(0, 0, "Area 1")
  StatusBarText(0, 1, "Area 2", #PB_StatusBar_BorderLess)
  StatusBarText(0, 2, "Area 3", #PB_StatusBar_Right | #PB_StatusBar_Raised)
  
  
  sbHwnd = StatusBarID(0)
  SendMessage_(sbHwnd, #SB_SETMINHEIGHT, 32, 0)
  SendMessage_(sbHwnd, #WM_SIZE, 0,0)
  SetWindowTheme_(sbHwnd,"","")
  SendMessage_(sbHwnd, #SB_SETBKCOLOR, 0, $67FD77)    
  Repeat

  Until WaitWindowEvent() = #PB_Event_CloseWindow
  
EndIf
Egypt my love
User avatar
Michael Vogel
Addict
Addict
Posts: 2860
Joined: Thu Feb 09, 2006 11:27 pm
Contact:

Re: [Windows] Colorizing things...

Post by Michael Vogel »

Thanks for all your ideas and snippets, I'll try to extract the best things of all of them :lol:

The result is much longer than 50 lines, and there are many reasons for that:
- standard font for the statusbar
- vertical centering needs minimum DPI adjustments
- colorizing the caption and the statusbar together
- can't remove or colorize this ugly grip sizer (#SBS_SIZEGRIP), otherwise Rachad's code would be perfect

Some things which are not perfect for me:
- the grip sizing symbol of the statusbar won't be seen when overlaying a gadget (as seen already in the initial post)
- windows does select a white or black text color for the caption automatically (which is fine) but I was not able to synchronize the statusbar text color (DwmGetWindowAttribute fails, so I set the color by a simple formula)

Code: Select all

; Define

	EnableExplicit

	Structure StatusType
		Window.i
		Status.i
		Gadget.i
		Image.i
		Font.i
		FontHeight.i
		FontOffset.i
		Width.i
		Height.i
		TextColor.i
		Color.i
		Text.s
		ForceUpdate.i
		DpiScale.i
	EndStructure

	Global Bar.StatusType

	#DpiBits=		12+SizeOf(Integer)
	#DpiScale=  	1<<#DpiBits
	#Undefined=		-1

	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)
	PrototypeC.i DwmGetWindowAttribute(hwnd.i, dwAttribute.l, *pvAttribute, cbAttribute.l)
		
; EndDefine
	
Macro MixColors(ColA,ColB)
	( ((((ColB&$FF00)+(ColA&$FF00))>>1)&$FF00) | ((((ColB&$FF00FF)+(ColA&$FF00FF))>>1)&$FF00FF) )
EndMacro
Macro ScaleUp(value)
	;
	(((value)*Bar\DpiScale)/#DpiScale)

EndMacro
Macro ScaleDown(value)

	(((value)*#DpiScale)/Bar\DpiScale);

EndMacro

Procedure InitSystemFont(win)

	Protected hdc
	Protected ncm.NONCLIENTMETRICS

	With Bar

		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)
		\FontHeight=Abs(ncm\lfStatusFont\lfHeight)

		\DpiScale=GetDeviceCaps_(GetDC_(0),#LOGPIXELSX)<<#DpiBits/96
	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)
		\Height=	StatusBarHeight(status)
		\FontOffset=(ScaleDown(\Height)-\FontHeight)*0.444
		CreateImage(\Image,\Width,\Height,24,color)
		ImageGadget(\Gadget,0,0,\Width,\Height,ImageID(\Image)); 0,1 to keep a line
		SetParent_(GadgetID(\Gadget),StatusBarID(\Status))
		\ForceUpdate=#True

	EndWith

EndProcedure
Procedure UpdateStatusBar()

	Protected n

	With Bar
		n=WindowWidth(\Window)
		If n<>\Width
			\Width=n
			\Height=StatusBarHeight(\Status)
			CreateImage(\Image,\Width,\Height)
			\ForceUpdate=#True
		EndIf

		If \ForceUpdate

			StartDrawing(ImageOutput(\Image))
			Box(0,0,\Width,\Height,\Color)

			DrawingFont(\Font)
			DrawText(10,\FontOffset,"Test "+FormatDate("%hh:%ii:%ss",Date()),\TextColor,\Color)

			Box(120,5,\Width-140,\Height-12,#Black)
			Box(121,6,\Width-142,\Height-14,#White)
			Box(122,7,Random(\Width-146),\Height-16,#Red)

			StopDrawing()

			SetGadgetState(\Gadget,ImageID(\Image))
			\ForceUpdate=#Null
		EndIf

	EndWith

EndProcedure
Procedure RedrawStatusBar()

	Bar\ForceUpdate=#True
	UpdateStatusBar()

EndProcedure
Procedure ColorizeAll()

	Protected Color.l
	Protected DwmSetWindowAttribute.DwmSetWindowAttribute
	Protected DwmGetWindowAttribute.DwmGetWindowAttribute

	With Bar

		\Color=		Random(#White)
		
		SetWindowColor(0,MixColors(#White,\Color))

		If OpenLibrary(0, "dwmapi")
			DwmSetWindowAttribute = GetFunction(0, "DwmSetWindowAttribute")
			;Color=\DarkMode :	DwmSetWindowAttribute(WindowID(0), #DWMWA_USE_IMMERSIVE_DARK_MODE,	@Color, SizeOf(Color))
			Color=\Color : 		DwmSetWindowAttribute(WindowID(0), #DWMWA_CAPTION_COLOR,			@Color, SizeOf(Color))
			;Color=\TextColor :	DwmSetWindowAttribute(WindowID(0), #DWMWA_TEXT_COLOR,				@Color, SizeOf(Color))
			;Color=\Border :   	DwmSetWindowAttribute(WindowID(0), #DWMWA_BORDER_COLOR,				@Color, SizeOf(Color))
			
			DwmGetWindowAttribute = GetFunction(0, "DwmGetWindowAttribute")
			DwmGetWindowAttribute(WindowID(0), #DWMWA_TEXT_COLOR, @Color, SizeOf(Color)) : \TextColor=Color
			\TextColor=	#White*Bool(\Color&$FF + (\Color>>8)&$FF + (\Color>>16)&$FF < 333)
			
			CloseLibrary(0)
		EndIf

		RedrawStatusBar()

	EndWith
EndProcedure

OpenWindow(0, 50, 50, 600, 400, "Colored Window", #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget|#PB_Window_SizeGadget|#PB_Window_Invisible)
CreateStatusBar(0, WindowID(0))
InitSystemFont(0)
InitStatusBar(0,0,0,0)
ColorizeAll()
HideWindow(0,0)

AddWindowTimer(0,0,500)
Repeat
	Select WaitWindowEvent()
	Case #PB_Event_CloseWindow
		End
	Case #PB_Event_Timer
		ColorizeAll()
	EndSelect
ForEver
User avatar
Michael Vogel
Addict
Addict
Posts: 2860
Joined: Thu Feb 09, 2006 11:27 pm
Contact:

Re: [Windows] Colorizing things...

Post by Michael Vogel »

I am still playing around with all your fine examples above to create a simple solution...
Rashad's code is nearly perfect but for changing the textcolor needs extra work: it seems to need additional gadgets (and so the system font) or callbacks (mk-soft's code).

So I did a mix now (including MK's callback) and the result has half the size of my code above but is twice as long as Rashad's...
...still not perfect (I can't read the automatically assigned text color of the caption) and removing the grip size element is done very rude (toggling the the WS_SizeBox flag at the start).

Code: Select all

; Define

	Structure StatusType
		TextColor.i
		Color.i
		Text.s[3]
	EndStructure

	Global Bar.StatusType

	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)
	PrototypeC.i DwmGetWindowAttribute(hwnd.i, dwAttribute.l, *pvAttribute, cbAttribute.l)

; EndDefine

Macro MixColors(ColA,ColB)
	( ((((ColB&$FF00)+(ColA&$FF00))>>1)&$FF00) | ((((ColB&$FF00FF)+(ColA&$FF00FF))>>1)&$FF00FF) )
EndMacro
Procedure BarCallback(hWnd,uMsg,wParam,lParam)

	Protected *draw.DRAWITEMSTRUCT

	Select UMsg
	Case #WM_DRAWITEM
		*draw = lParam
		If *draw\hwndItem = StatusBarID(0)
			SetBkMode_(*draw\hDC,#TRANSPARENT)
			SetTextColor_(*draw\hdc,Bar\TextColor)
			*draw\rcItem\left + 2
			*draw\rcItem\right - 2
			DrawText_(*draw\hdc, @Bar\Text[*draw\itemID], Len(Bar\Text[*draw\itemID]), *draw\rcItem, #DT_VCENTER | #DT_SINGLELINE | #DT_END_ELLIPSIS)
		EndIf

	EndSelect

	ProcedureReturn #PB_ProcessPureBasicEvents

EndProcedure
Procedure UpdateStatusBar()

	Protected n

	#SB_SETBKCOLOR = $2001
	sbHwnd = StatusBarID(0)
	;SendMessage_(sbHwnd, #SB_SETMINHEIGHT,36, 0)
	SendMessage_(sbHwnd, #WM_SIZE, 0,0)
	SetWindowTheme_(sbHwnd,"","")
	SendMessage_(sbHwnd, #SB_SETBKCOLOR, 0,Bar\Color)
	
	Bar\Text[2]=FormatDate("%hh:%ii:%ss",Date())
	;StatusBarText(0,2,"!",#PB_StatusBar_BorderLess)

EndProcedure
Procedure ColorizeAll()

	Protected Color.l
	Protected DwmSetWindowAttribute.DwmSetWindowAttribute
	Protected DwmGetWindowAttribute.DwmGetWindowAttribute

	With Bar

		\Color=		Random(#White)

		SetWindowColor(0,MixColors(#White,\Color))

		If OpenLibrary(0, "dwmapi")
			DwmSetWindowAttribute = GetFunction(0, "DwmSetWindowAttribute")
			;Color=\DarkMode :	DwmSetWindowAttribute(WindowID(0), #DWMWA_USE_IMMERSIVE_DARK_MODE,	@Color, SizeOf(Color))
			Color=\Color : 		DwmSetWindowAttribute(WindowID(0), #DWMWA_CAPTION_COLOR,			@Color, SizeOf(Color))
			;Color=\Border :   	DwmSetWindowAttribute(WindowID(0), #DWMWA_BORDER_COLOR,				@Color, SizeOf(Color))
			
			; Getting Textcolor fails...
			;DwmGetWindowAttribute = GetFunction(0, "DwmGetWindowAttribute")
			;DwmGetWindowAttribute(WindowID(0), #DWMWA_TEXT_COLOR, @Color, SizeOf(Color)) : \TextColor=Color
			
			; Workaround...
			\TextColor=	#White*Bool(\Color&$FF + (\Color>>8)&$FF + (\Color>>16)&$FF < 333)
			Color=\TextColor :	DwmSetWindowAttribute(WindowID(0), #DWMWA_TEXT_COLOR,				@Color, SizeOf(Color))

			CloseLibrary(0)
		EndIf

		UpdateStatusBar()

	EndWith
EndProcedure

win=OpenWindow(0, 50, 50, 600, 400, "Colored Window", #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget|#PB_Window_Invisible)
CreateStatusBar(0, WindowID(0))
SetWindowLong_(win,#GWL_STYLE,GetWindowLong_(win,#GWL_STYLE)|#WS_SIZEBOX)

AddStatusBarField(8)
AddStatusBarField(100)
AddStatusBarField(200)
AddStatusBarField(#PB_Ignore)
AddStatusBarField(8)

StatusBarText(0,0,"",#PB_StatusBar_BorderLess)
;StatusBarText(0,1,"Hello",#PB_StatusBar_BorderLess)
;StatusBarText(0,2,"World!",#PB_StatusBar_BorderLess)
StatusBarProgress(0,3,50,#PB_StatusBar_BorderLess)
StatusBarText(0,4,"",#PB_StatusBar_BorderLess)

SendMessage_(StatusBarID(0), #SB_SETTEXT, #SBT_NOBORDERS | #SBT_OWNERDRAW | 1, 0)
SendMessage_(StatusBarID(0), #SB_SETTEXT, #SBT_NOBORDERS | #SBT_OWNERDRAW | 2, 0)
Bar\Text[1]="Hello"

SetWindowCallback(@BarCallback(),0)
ColorizeAll()
HideWindow(0,0)

AddWindowTimer(0,0,500)
Repeat
	Select WaitWindowEvent()
	Case #PB_Event_CloseWindow
		End
	Case #PB_Event_Timer
		ColorizeAll()
	EndSelect
ForEver
User avatar
Jacobus
Enthusiast
Enthusiast
Posts: 166
Joined: Wed Nov 16, 2005 7:51 pm
Location: France
Contact:

Re: [Windows] Colorizing things...

Post by Jacobus »

breeze4me wrote: Mon Feb 09, 2026 11:06 am If it's just dark mode rather than coloring, you can do it as shown below.

Code: Select all

 SetWindowTheme_(StatusBarID(0), 0, "DarkMode::ExplorerStatusBar") 
Thank you very much, just what I needed to complete the dark mode that I was able to implement in an application with Zapman's SetGadgetColorEx() library. :)
PureBasicien tu es, PureBasicien tu resteras.
PHP
User
User
Posts: 79
Joined: Sat Sep 10, 2005 5:38 pm

Re: [Windows] Colorizing things...

Post by PHP »

I still wonder why it is not possible to colour a simple button using on-board tools.

I used to always use PureCOLOR for this, but this library is no longer being developed and no longer works with 6.30.
User avatar
mk-soft
Always Here
Always Here
Posts: 6585
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: [Windows] Colorizing things...

Post by mk-soft »

This question must be asked by Microsoft ...
My Projects EventDesigner V3 / ThreadToGUI / OOP-BaseClass / Windows: Module ActiveScript
PB v3.30 / v5.75 - OS Mac Mini - VM Window Pro / Linux Ubuntu
Downloads on my OneDrive
Post Reply