Recent

Author Topic: [solved] How to control checkbox colors  (Read 4459 times)

Joanna

  • Hero Member
  • *****
  • Posts: 863
[solved] How to control checkbox colors
« on: May 23, 2024, 04:45:23 pm »
I am making a new control
Tmycheckbox = class(tcheckbox)

Currently the checkbox interior is black and the check mark is yellow. How can I change these colors to better match the checkbox font and background colors? Also is there a way to control the color of box itself?
« Last Edit: May 24, 2024, 10:00:20 pm by Joanna »
✨ 🙋🏻‍♀️ More Pascal enthusiasts are needed on IRC .. https://libera.chat/guides/ IRC.LIBERA.CHAT  Ports [6667 plaintext ] or [6697 secure] channel #fpc  Please private Message me if you have any questions or need assistance. 💁🏻‍♀️

lainz

  • Hero Member
  • *****
  • Posts: 4571
  • Web, Desktop & Android developer
    • https://lainz.github.io/
Re: How to control checkbox colors
« Reply #1 on: May 23, 2024, 05:13:31 pm »
I am making a new control
Tmycheckbox = class(tcheckbox)

Currently the checkbox interior is black and the check mark is yellow. How can I change these colors to better match the checkbox font and background colors? Also is there a way to control the color of box itself?

Hi Joanna, you can use BGRAControls. There is TBGRAThemeCheckBox, you can drop a TBGRASVGTheme then and add the SVG images you want.
« Last Edit: May 23, 2024, 05:15:02 pm by lainz »

Joanna

  • Hero Member
  • *****
  • Posts: 863
Re: How to control checkbox colors
« Reply #2 on: May 23, 2024, 07:38:53 pm »
Thanks lainz
That seems complicated To add an image I was hoping to just override the method that paints the checkbox or something
✨ 🙋🏻‍♀️ More Pascal enthusiasts are needed on IRC .. https://libera.chat/guides/ IRC.LIBERA.CHAT  Ports [6667 plaintext ] or [6697 secure] channel #fpc  Please private Message me if you have any questions or need assistance. 💁🏻‍♀️

Handoko

  • Hero Member
  • *****
  • Posts: 5245
  • My goal: build my own game engine using Lazarus
Re: How to control checkbox colors
« Reply #3 on: May 23, 2024, 07:53:23 pm »
... I was hoping to just override the method that paints the checkbox or something

No, you can't. TCheckBox depends heavily on the related OS' API.

If the OS does not provide such feature, not much you can do. Actually you could but only if you're really good in understanding how the OS/API works, so you might hack into and modify its default behavior but that is nearly impossible.

Joanna

  • Hero Member
  • *****
  • Posts: 863
Re: How to control checkbox colors
« Reply #4 on: May 23, 2024, 08:25:11 pm »
No wonder I couldn’t find the code for drawing it. How about tcdcheckbox is it possible to change colors?
✨ 🙋🏻‍♀️ More Pascal enthusiasts are needed on IRC .. https://libera.chat/guides/ IRC.LIBERA.CHAT  Ports [6667 plaintext ] or [6697 secure] channel #fpc  Please private Message me if you have any questions or need assistance. 💁🏻‍♀️

Handoko

  • Hero Member
  • *****
  • Posts: 5245
  • My goal: build my own game engine using Lazarus
Re: How to control checkbox colors
« Reply #5 on: May 23, 2024, 08:41:03 pm »
Because TcdCheckBox does not depend on the OS' API.

Most of the default Lazarus components map/link to the OS' API. for example, Linux's API provides user to change button color but Windows does not. So TButton's color can be changed if it runs on Linux but not on Windows.

lainz

  • Hero Member
  • *****
  • Posts: 4571
  • Web, Desktop & Android developer
    • https://lainz.github.io/
Re: How to control checkbox colors
« Reply #6 on: May 23, 2024, 10:17:46 pm »
No wonder I couldn’t find the code for drawing it. How about tcdcheckbox is it possible to change colors?

Yes but you need to override a theme.

lainz

  • Hero Member
  • *****
  • Posts: 4571
  • Web, Desktop & Android developer
    • https://lainz.github.io/
Re: How to control checkbox colors
« Reply #7 on: May 24, 2024, 01:55:20 am »
Thanks lainz
That seems complicated To add an image I was hoping to just override the method that paints the checkbox or something

Is just XML, is pasted as text in the editor.

To draw a checkbox just use Inkscape, is not that hard to draw with it, just like any other drawing program.

If Inkscape is too hard for you, you can try LazPaint.

Joanna

  • Hero Member
  • *****
  • Posts: 863
Re: How to control checkbox colors
« Reply #8 on: May 24, 2024, 09:59:48 pm »
Thanks for the answers
✨ 🙋🏻‍♀️ More Pascal enthusiasts are needed on IRC .. https://libera.chat/guides/ IRC.LIBERA.CHAT  Ports [6667 plaintext ] or [6697 secure] channel #fpc  Please private Message me if you have any questions or need assistance. 💁🏻‍♀️

KodeZwerg

  • Hero Member
  • *****
  • Posts: 2269
  • Fifty shades of code.
    • Delphi & FreePascal
Re: How to control checkbox colors
« Reply #9 on: May 24, 2024, 11:22:41 pm »
... I was hoping to just override the method that paints the checkbox or something

No, you can't. TCheckBox depends heavily on the related OS' API.

If the OS does not provide such feature, not much you can do. Actually you could but only if you're really good in understanding how the OS/API works, so you might hack into and modify its default behavior but that is nearly impossible.
Your "nearly impossible" and "no you cant" catched my attention so here is just a proof-of-concept :D
Code: Pascal  [Select][+][-]
  1.  uses ... LMessages, LCLType, LCLIntf ...
  2.  
  3. type
  4.  
  5.   { TCheckBox }
  6.  
  7.   TCheckBox = class(StdCtrls.TCheckBox)
  8.     protected
  9.       procedure WndProc(var Message: TLMessage); override;
  10.   end;
  11.  
  12. implementation
  13.  
  14. procedure TCheckBox.WndProc(var Message: TLMessage);
  15. var
  16.   bmp: Graphics.TBitmap;
  17.   DC: HDC;
  18.   Canvas: TCanvas;
  19. begin
  20.   inherited;
  21.  
  22.   if Message.Msg = LM_PAINT then
  23.     begin
  24.       DC := GetDC(Handle);
  25.       try
  26.         Canvas := TCanvas.Create;
  27.         try
  28.           Canvas.Handle := DC;
  29.           bmp := Graphics.TBitmap.Create;
  30.           try
  31.             bmp.PixelFormat := pf24bit;
  32.             bmp.SetSize(13, 13);
  33.             bmp.Canvas.Brush.Style := bsSolid;
  34.             if Self.Color = clDefault then
  35.               begin
  36.                 bmp.Canvas.Brush.Color := Self.GetDefaultColor(dctBrush);
  37.                 Canvas.Brush.Color := Self.GetDefaultColor(dctBrush);
  38.               end
  39.             else
  40.               begin
  41.                 bmp.Canvas.Brush.Color := Self.Color;
  42.                 Canvas.Brush.Color := Self.Color;
  43.               end;
  44.             Canvas.FillRect(Canvas.ClipRect);
  45.             bmp.Canvas.FillRect(bmp.Canvas.ClipRect);
  46.             if Checked then
  47.               bmp.Canvas.Brush.Color := clLime
  48.             else
  49.               bmp.Canvas.Brush.Color := clRed;
  50.             bmp.Canvas.Pen.Style := psSolid;
  51.             bmp.Canvas.Pen.Color := clBlack;
  52.             bmp.Canvas.Pen.Width := 1;
  53.             bmp.Canvas.Ellipse(bmp.Canvas.ClipRect);
  54.             Canvas.Draw(2, (Canvas.Height - bmp.Height) div 2, bmp);
  55.             Canvas.Font := Self.Font;
  56.             Canvas.TextOut(16, (Canvas.Height - Canvas.TextHeight(Self.Caption)) div 2, Self.Caption);
  57.           finally
  58.             bmp.Free;
  59.           end;
  60.         finally
  61.           Canvas.Free;
  62.         end;
  63.       finally
  64.         ReleaseDC(Handle, DC);
  65.       end;
  66.     end;
  67. end;
Lazarus 3.99 (rev main_3_99-1993-g5ad1922ccb) FPC 3.2.2 x86_64-win64-win32/win64

// updated sample that it actual use the "Color" property as background and "Font.Color" for the caption.
« Last Edit: May 25, 2024, 12:36:15 am by KodeZwerg »
« Last Edit: Tomorrow at 31:76:97 xm by KodeZwerg »

Handoko

  • Hero Member
  • *****
  • Posts: 5245
  • My goal: build my own game engine using Lazarus
Re: [solved] How to control checkbox colors
« Reply #10 on: May 25, 2024, 04:57:06 am »
Nice!

You're the minority that can make nearly impossible things to happen.

KodeZwerg

  • Hero Member
  • *****
  • Posts: 2269
  • Fifty shades of code.
    • Delphi & FreePascal
Re: [solved] How to control checkbox colors
« Reply #11 on: May 25, 2024, 02:22:03 pm »
Nice!

You're the minority that can make nearly impossible things to happen.
:o  :P Thanks, I tried to make the component transparent but currently failed, I assume I would need to hop on LM_CREATE to make it happen

anyway, here is my latest revision, its more clean now and prepared for transparency, interception works for both ways same, if control is on form or within a container like TPanel.
many things missing like mouse over events with a different border around circle.
Code: Pascal  [Select][+][-]
  1. type
  2.  
  3.   { TCheckBox }
  4.  
  5.   TCheckBox = class(StdCtrls.TCheckBox)
  6.     strict private
  7.       FTransparent: Boolean;
  8.       FMouseOver: Boolean;
  9.     private
  10.       procedure SetTransparent(const AValue: Boolean);
  11.       procedure CreateImage(var AImage: TCustomBitmap);
  12.     protected
  13.       procedure WndProc(var Message: TLMessage); override;
  14.       procedure MouseEnter; override;
  15.       procedure MouseLeave; override;
  16.     public
  17.     published
  18.       property Transparent: Boolean read FTransparent write SetTransparent stored True default False;
  19.   end;
Code: Pascal  [Select][+][-]
  1. procedure TCheckBox.WndProc(var Message: TLMessage);
  2. var
  3.   LBitmap: TCustomBitmap;
  4.   LDC: HDC;
  5.   LCanvas: TCanvas;
  6. begin
  7.   inherited;
  8.   case Message.Msg of
  9.     LM_DESTROY: begin // LM_DESTROY
  10.                 end; // LM_DESTROY
  11.     LM_PAINT: begin // LM_PAINT
  12.                   LCanvas := TCanvas.Create;
  13.                   try
  14.                     LDC := GetDC(Self.Handle);
  15.                     try
  16.                       LCanvas.Handle := LDC;
  17.                       CreateImage(LBitmap{%H-});
  18.                       try
  19.                         LCanvas.Draw(0, 0, LBitmap);
  20.                       finally
  21.                         LBitmap.Free;
  22.                       end;
  23.                     finally
  24.                       ReleaseDC(Self.Handle, LDC);
  25.                     end;
  26.                   finally
  27.                     LCanvas.Free;
  28.                   end;
  29.               end; // LM_PAINT
  30.     end; // case Message.Msg of
  31. end;
  32.  
  33. procedure TCheckBox.SetTransparent(const AValue: Boolean);
  34. begin
  35.   if FTransparent = AValue then
  36.     Exit;
  37.   FTransparent := AValue;
  38.   Self.Invalidate;
  39. end;
  40.  
  41. procedure TCheckBox.CreateImage(var AImage: TCustomBitmap);
  42. var
  43.   LBitmap: TCustomBitmap;
  44.   LBackground: TColor;
  45.   LRect: TRect;
  46. begin
  47.   // setup background color
  48.   if Self.Color = clDefault then
  49.     LBackground := Self.GetDefaultColor(dctBrush)
  50.   else
  51.     LBackground := Self.Color;
  52.   // create image to paint on
  53.   LBitmap := Graphics.TCustomBitmap.Create{%H-};
  54.   try
  55.     // setup defaults
  56.     LBitmap.SetSize(Self.ClientWidth, Self.ClientHeight);
  57.     LBitmap.Canvas.AntialiasingMode := amDontCare; //amOn;
  58.     LBitmap.Canvas.CopyMode := cmSrcCopy;
  59.     // setup font
  60.     LBitmap.Canvas.Font := Self.Font;
  61.     if Self.Font.Color = clDefault then
  62.       LBitmap.Canvas.Font.Color := Self.GetDefaultColor(dctFont);
  63.     // alpha test: transparency
  64.     // does not work :D (LBitmap is transparent but the control is not)
  65.     // currently it would let original CheckBox painting shine thru
  66.     if FTransparent then
  67.       begin
  68.         LBitmap.TransparentMode := tmFixed;
  69.         LBitmap.TransparentColor := LBackground;
  70.         LBitmap.Transparent := True;
  71.       end;
  72.     // setup initial canvas values
  73.     LBitmap.Canvas.Brush.Color := LBackground;
  74.     LBitmap.Canvas.Brush.Style := bsSolid;
  75.     LBitmap.Canvas.Pen.Style := psSolid;
  76.     // add small effect when the mouse is over the control
  77.     if FMouseOver then
  78.       LBitmap.Canvas.Pen.Color := clBtnHighlight
  79.     else
  80.       LBitmap.Canvas.Pen.Color := clBlack;
  81.     LBitmap.Canvas.Pen.Width := 1;
  82.     // clear image
  83.     LBitmap.Canvas.FillRect(LBitmap.Canvas.ClipRect);
  84.     // prepare circle coordinates
  85.     LRect.Top := (LBitmap.Canvas.Height - 13) div 2;
  86.     if (Self.Alignment = taRightJustify) and (Self.BiDiMode <> bdRightToLeft) then
  87.       LRect.Left := 2;
  88.     if (
  89.         ((Self.Alignment = taRightJustify) and (Self.BiDiMode = bdRightToLeft))
  90.         or
  91.         ((Self.Alignment = taLeftJustify) and (Self.BiDiMode = bdRightToLeft))
  92.         or
  93.         ((Self.Alignment = taLeftJustify) and (Self.BiDiMode = bdLeftToRight))
  94.         )
  95.        then
  96.       LRect.Left := LBitmap.Canvas.ClipRect.Width - 15;
  97.     LRect.Right := LRect.Left + 13;
  98.     LRect.Bottom := LRect.Top + 13;
  99.     // choose color by current state
  100.     if Self.Checked or (Self.State = cbChecked) then
  101.       LBitmap.Canvas.Brush.Color := clLime;
  102.     if (not Self.Checked) or (Self.State = cbUnchecked) then
  103.       LBitmap.Canvas.Brush.Color := clRed;
  104.     if (Self.State = cbGrayed) then
  105.       LBitmap.Canvas.Brush.Color := clMedGray;
  106.     LBitmap.Canvas.Ellipse(LRect);
  107.     // prepare color and write text
  108.     LBitmap.Canvas.Brush.Color := LBackground;
  109.     if (Self.Alignment = taRightJustify) and (Self.BiDiMode <> bdRightToLeft) then
  110.       LBitmap.Canvas.TextOut(16, (LBitmap.Canvas.Height - LBitmap.Canvas.TextHeight(Self.Caption)) div 2, Self.Caption)
  111.     else
  112.       LBitmap.Canvas.TextOut(1, (LBitmap.Canvas.Height - LBitmap.Canvas.TextHeight(Self.Caption)) div 2, Self.Caption);
  113.     // when focused draw a rectangle around
  114.     if Self.Focused then
  115.       begin
  116.         LBitmap.Canvas.Brush.Color := clActiveCaption;
  117.         LBitmap.Canvas.FrameRect(LBitmap.Canvas.ClipRect);
  118.       end;
  119.     // transport image
  120.     AImage := TCustomBitmap.Create;
  121.     AImage.Assign(LBitmap);
  122.   finally
  123.     LBitmap.Free;
  124.   end;
  125. end;
  126.  
  127. procedure TCheckBox.MouseEnter;
  128. begin
  129.   FMouseOver := True;
  130.   inherited MouseEnter;
  131. end;
  132.  
  133. procedure TCheckBox.MouseLeave;
  134. begin
  135.   FMouseOver := False;
  136.   inherited MouseLeave;
  137. end;

//updated
now it reacts visual when mouse is over
bidi/alignment supported
gray possibility included
custom focus rectangle added
removed the draw routines from OnPaint
« Last Edit: May 25, 2024, 10:24:50 pm by KodeZwerg »
« Last Edit: Tomorrow at 31:76:97 xm by KodeZwerg »

lainz

  • Hero Member
  • *****
  • Posts: 4571
  • Web, Desktop & Android developer
    • https://lainz.github.io/
Re: [solved] How to control checkbox colors
« Reply #12 on: May 25, 2024, 08:43:38 pm »
That code works in any platform? Just asking because I dont' know...

KodeZwerg

  • Hero Member
  • *****
  • Posts: 2269
  • Fifty shades of code.
    • Delphi & FreePascal
Re: [solved] How to control checkbox colors
« Reply #13 on: May 25, 2024, 10:45:27 pm »
That code works in any platform? Just asking because I dont' know...
I am no crossplatform expert but crosscompile units are used.
Attached is a simple demo project where TCheckBox gets intercepted.

Tested successful with Lazarus 3.99 (rev main_3_99-1993-g5ad1922ccb) FPC 3.2.2 x86_64-win64-win32/win64
« Last Edit: Tomorrow at 31:76:97 xm by KodeZwerg »

Joanna

  • Hero Member
  • *****
  • Posts: 863
Re: [solved] How to control checkbox colors
« Reply #14 on: May 27, 2024, 12:13:02 am »
Thanks kodezwerg
Is it possible to have a colored checkbox that looks more like the standard checkbox though?
« Last Edit: May 27, 2024, 03:36:18 am by Joanna »
✨ 🙋🏻‍♀️ More Pascal enthusiasts are needed on IRC .. https://libera.chat/guides/ IRC.LIBERA.CHAT  Ports [6667 plaintext ] or [6697 secure] channel #fpc  Please private Message me if you have any questions or need assistance. 💁🏻‍♀️

 

TinyPortal © 2005-2018