Recent

Author Topic: Trying to tweak the bsTriangle ButtonStyle of Laz.VirtualStringTree  (Read 1019 times)

carl_caulkett

  • Hero Member
  • *****
  • Posts: 649
* Mac Mini M1
* macOS 14.6.1
* Lazarus 3.99
* FPC 3.3.1

I'm trying to tweak the drawing code of the node buttons of the Laz.VirtualStringTree. If I set the ButtonStyle property to bsRectangle the node buttons are displayed in a mid-grey colour which works well with my dark themed macOS, and I imagine that it will work well on a light background.

If, however, I set the ButtonStyle property to bsTriangle the node buttons are displayed as black triangles with a purple outline (see attached image). I've looked at the two places where the code diverges according to the ButtonStyle. In both cases the code is like this...
Code: Pascal  [Select][+][-]
  1.   if FButtonStyle = bsTriangle then
  2.   begin
  3.     Brush.Color := clBlack;
  4.     Pen.Color := clBlack;
  5.  

Firstly the use of hard coded colours means that this is not theme-aware. Secondly, although purple is selected as my macOS AccentColor in "System Settings" -> "Appearance", I don't see why it is showing as an outline to all node buttons, especially when none of them are selected and needing highlighting...

I've tried changing the hard-coded colours to clBtnShadow to try and match the colours used by the bsRectangle ButtonStyle...
Code: Pascal  [Select][+][-]
  1.   if FButtonStyle = bsTriangle then
  2.   begin
  3.     Brush.Color := clBtnShadow;
  4.     Pen.Color := clBtnShadow;
  5.  

...but still the purple outline remains.

I'm wandering if I need to approach this a different way, using the StateImages property perhaps.

Before anyone says anything, I know that it is bad practice to tweak other people's component code and that it is far better practice to operate within the limits of the component, or to sub-class and tweak, maybe.

Thoughts, anyone?
« Last Edit: October 01, 2024, 12:03:52 am by carl_caulkett »
"It builds... ship it!"

carl_caulkett

  • Hero Member
  • *****
  • Posts: 649
Re: Trying to tweak the bsTriangle ButtonStyle of Laz.VirtualStringTree
« Reply #1 on: October 02, 2024, 08:15:12 pm »
I've made some progress via the "OnAfterI]"]>Blockedaint" event, and have managed to get nice arrow shapes which match the node "TreeLineColor".

One thing I haven't sorted is the fact that when I first start the app, the TLazVirtualStringGrid, even though it is the default active control, displays as shown in the first image.

If I press tab a couple of times so that focus returns to the TLazVirtualStringGrid, now there is a border around the 0th column cell, and the painting of  the border around the arrow is correct. I cannot figure out what I need to test for in order to programmatically distinguish between these two focused states.

This is my unfinished code...
Code: Pascal  [Select][+][-]
  1. procedure TMain.PresetTreeAfterItemPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; const ItemRect: TRect);
  2. var
  3.   Level: Cardinal;
  4.   CatPtr: PCategory;
  5.  
  6.   procedure DrawArrow(Canvas: TCanvas; Expanded, Selected, Focused: Boolean; Name: string);
  7.   var
  8.     Points: array[0..2] of TPoint;
  9.     ArrowColor: TColor;
  10.   begin
  11.     if Name = ALL_CATEGORIES then db('enter DrawArrow');
  12.     if Focused then
  13.     begin
  14.       Canvas.Pen.Color := PresetTree.Colors.FocusedSelectionColor;
  15.       Canvas.Brush.Color := PresetTree.Colors.FocusedSelectionColor;
  16.     end
  17.     else
  18.     begin
  19.       Canvas.Pen.Color := PresetTree.Colors.UnfocusedColor;
  20.       Canvas.Brush.Color := PresetTree.Colors.UnfocusedColor;
  21.     end;
  22.     Canvas.FillRect(1, 1, 16, 16);
  23.  
  24.     if Focused then
  25.       ArrowColor := PresetTree.Colors.SelectionTextColor
  26.     else
  27.       ArrowColor := PresetTree.Colors.TreeLineColor;
  28.     Canvas.Pen.Color := ArrowColor;
  29.     Canvas.Brush.Color := ArrowColor;
  30.  
  31.     if Expanded then
  32.     begin
  33.       // Down arrow
  34.       Points[0] := Point(6, 5);
  35.       Points[1] := Point(14, 5);
  36.       Points[2] := Point(10, 11);
  37.     end
  38.     else
  39.     begin
  40.       // Right arrow
  41.       Points[0] := Point(6, 4);
  42.       Points[1] := Point(12, 8);
  43.       Points[2] := Point(6, 12);
  44.     end;
  45.     Canvas.Polygon(Points);
  46.     if Name = ALL_CATEGORIES then db('exit DrawArrow');
  47.   end;
  48.  
  49. begin
  50.   Level := PresetTree.GetNodeLevel(Node);
  51.   if Level = 0 then
  52.   begin
  53.     CatPtr := PresetTree.GetNodeData(Node);
  54.     DrawArrow(TargetCanvas, PresetTree.Expanded[Node], PresetTree.Selected[Node], (Node = PresetTree.FocusedNode) and PresetTree.Focused, CatPtr^.Name);
  55.   end;
  56. end;
  57.  

My ideal display would be the full width row highlight of the second image but without the light colored border around the 0th column cell.

So, in short, the question is: how do I distinguish, programatically, between the state of the grid in the two images?
« Last Edit: October 02, 2024, 08:26:28 pm by carl_caulkett »
"It builds... ship it!"

carl_caulkett

  • Hero Member
  • *****
  • Posts: 649
Re: Trying to tweak the bsTriangle ButtonStyle of Laz.VirtualStringTree
« Reply #2 on: October 02, 2024, 08:21:55 pm »
db('string') simply refers to a keystroke-saving wrapper around "dbugintf", which will be added to as the need arises...
Code: Pascal  [Select][+][-]
  1. unit uDbg;
  2.  
  3. {$mode ObjFPC}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, DBugIntf;
  9.  
  10. function dbinit: Boolean;
  11. function db(msg: string): Boolean;
  12. function db(id: string; val: Integer): Boolean;
  13.  
  14. implementation
  15.  
  16. function dbinit: Boolean;
  17. begin
  18.   Result := InitDebugClient;
  19. end;
  20.  
  21. function db(msg: string): Boolean;
  22. begin
  23.   Result := SendDebug(msg);
  24. end;
  25.  
  26. function db(id: string; val: Integer): Boolean;
  27. begin
  28.   Result := SendInteger(id, val);
  29. end;
  30.  
  31. end.
  32.  
"It builds... ship it!"

carl_caulkett

  • Hero Member
  • *****
  • Posts: 649
Re: Trying to tweak the bsTriangle ButtonStyle of Laz.VirtualStringTree
« Reply #3 on: October 02, 2024, 10:01:44 pm »
The problem was that I was trying to do two different things in one nested procedure. So I created a second nested procedure so there is one to draw the background, and one to draw the tree nodes. This made everything much clearer!
Code: Pascal  [Select][+][-]
  1. procedure TMain.PresetTreeAfterItemPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; const ItemRect: TRect);
  2. var
  3.   Level: Cardinal;
  4.   IsSelected: Boolean;
  5.   IsFocused: Boolean;
  6.   IsExpanded: Boolean;
  7.  
  8.   procedure DrawBackground(Canvas: TCanvas; Selected, Focused: Boolean);
  9.   begin
  10.     if Focused or Selected then
  11.     begin
  12.       Canvas.Pen.Color := PresetTree.Colors.FocusedSelectionColor;
  13.       Canvas.Brush.Color := PresetTree.Colors.FocusedSelectionColor;
  14.     end
  15.     else
  16.     begin
  17.       Canvas.Pen.Color := PresetTree.Colors.UnfocusedColor;
  18.       Canvas.Brush.Color := PresetTree.Colors.UnfocusedColor;
  19.     end;
  20.     Canvas.FillRect(1, 1, 16, 16);
  21.   end;
  22.  
  23.   procedure DrawArrow(Canvas: TCanvas; Expanded, Selected, Focused: Boolean);
  24.   var
  25.     Points: array[0..2] of TPoint;
  26.     ArrowColor: TColor;
  27.   begin
  28.     // Set colors
  29.     if Focused or Selected then
  30.       ArrowColor := PresetTree.Colors.SelectionTextColor
  31.     else
  32.       ArrowColor := PresetTree.Colors.TreeLineColor;
  33.     Canvas.Pen.Color := ArrowColor;
  34.     Canvas.Brush.Color := ArrowColor;
  35.     // Do the actual drawing
  36.     if Expanded then
  37.     begin
  38.       // Down arrow
  39.       Points[0] := Point(6, 5);
  40.       Points[1] := Point(14, 5);
  41.       Points[2] := Point(10, 11);
  42.     end
  43.     else
  44.     begin
  45.       // Right arrow
  46.       Points[0] := Point(6, 4);
  47.       Points[1] := Point(12, 8);
  48.       Points[2] := Point(6, 12);
  49.     end;
  50.     Canvas.Polygon(Points);
  51.   end;
  52.  
  53. begin
  54.   Level := PresetTree.GetNodeLevel(Node);
  55.   if Level = 0 then
  56.   begin
  57.     // Set state flags
  58.     IsSelected := PresetTree.Selected[Node] and PresetTree.Focused;
  59.     IsFocused := (Node = PresetTree.FocusedNode) and PresetTree.Focused;
  60.     IsExpanded := PresetTree.Expanded[Node];
  61.     // Call the drawing nested procedures
  62.     DrawBackground(TargetCanvas, IsSelected, IsFocused);
  63.     DrawArrow(TargetCanvas, IsExpanded, IsSelected, IsFocused);
  64.   end;
  65. end;
  66.  

I'm still getting the light gray outline around the 0th column cell when the focus returns to the TLazVirtualStringTree, but I'm a lot more confident of sorting it 😉
"It builds... ship it!"

carl_caulkett

  • Hero Member
  • *****
  • Posts: 649
Re: Trying to tweak the bsTriangle ButtonStyle of Laz.VirtualStringTree
« Reply #4 on: October 02, 2024, 11:01:35 pm »
A closer examination of the third image reveals that the outline around the 0th column cell is, in fact, a sort of Money Gray type color, but not exactly.

clMoneyGray is $C0DCC0.

As far. as I can tell the RGB for this color would be $90A890 or near enough, which doesn't seem to correspond with any of the named Lazarus colors.

This value was obtained from an app called "Digital Colour Meter", with the output set to "Native Values". I tested against clSilver and got values very close to $C0C0C0, which allowing for variations caused by the embedding of graphics in this forum, seem close enough for me!

I am perplexed 🤔
"It builds... ship it!"

dsiders

  • Hero Member
  • *****
  • Posts: 1282
Re: Trying to tweak the bsTriangle ButtonStyle of Laz.VirtualStringTree
« Reply #5 on: October 03, 2024, 03:21:20 am »
clMoneyGray is $C0DCC0.

Do you mean:
Code: Pascal  [Select][+][-]
  1. clMoneyGreen = TColor($C0DCC0); // BBGGRR byte order
?

As far. as I can tell the RGB for this color would be $90A890 or near enough, which doesn't seem to correspond with any of the named Lazarus colors.
plexed 🤔

Not quite. The RGB order would be the same.  $C0DCC0 in RRGGBB hex or 12632494 integer.

This value was obtained from an app called "Digital Colour Meter", with the output set to "Native Values". I tested against clSilver and got values very close to $C0C0C0, which allowing for variations caused by the embedding of graphics in this forum, seem close enough for me!

Then I would stop using it.
Preview the next Lazarus documentation release at: https://dsiders.gitlab.io/lazdocsnext

carl_caulkett

  • Hero Member
  • *****
  • Posts: 649
Re: Trying to tweak the bsTriangle ButtonStyle of Laz.VirtualStringTree
« Reply #6 on: October 03, 2024, 11:16:12 am »
clMoneyGray is $C0DCC0.

Do you mean:
Code: Pascal  [Select][+][-]
  1. clMoneyGreen = TColor($C0DCC0); // BBGGRR byte order
?

It was late! Forgive me 🙏🏽
"It builds... ship it!"

carl_caulkett

  • Hero Member
  • *****
  • Posts: 649
Re: Trying to tweak the bsTriangle ButtonStyle of Laz.VirtualStringTree
« Reply #7 on: October 03, 2024, 11:26:02 am »
As far. as I can tell the RGB for this color would be $90A890 or near enough, which doesn't seem to correspond with any of the named Lazarus colors.
plexed 🤔
Not quite. The RGB order would be the same.  $C0DCC0 in RRGGBB hex or 12632494 integer.
[/quote]

No, I wasn't talking about the clMoneyGreen color, but the color of the outline in image 3!

To confirm this I dropped a TPanel on the form and set its color to $90A890. Visually, it seems to be the same color as the outline in question!
"It builds... ship it!"

carl_caulkett

  • Hero Member
  • *****
  • Posts: 649
Re: Trying to tweak the bsTriangle ButtonStyle of Laz.VirtualStringTree
« Reply #8 on: October 03, 2024, 12:53:50 pm »
This value was obtained from an app called "Digital Colour Meter", with the output set to "Native Values". I tested against clSilver and got values very close to $C0C0C0, which allowing for variations caused by the embedding of graphics in this forum, seem close enough for me!

Then I would stop using it.

I used https://alternativeto.net to find an alternative Colour Picker. I eventually chose "Just Color Picker" which is especially good because it has an output option in Delphi/Lazarus format ($HHHHHH). Guess what, as I move across the panel shown in the last image, the colour value fluctuates slightly, just as it did in "Digital Colour Meter". I'm not a betting man, but if I were, I would bet on the apps being correct, and that the app authors might, actually, know what they are talking about.

In fact, it has nothing to do with variation caused by the embedding of images in this forum; I get exactly the same, slight fluctuations, when scanning the $90A890 panel of the app itself  :o
"It builds... ship it!"

carl_caulkett

  • Hero Member
  • *****
  • Posts: 649
Re: Trying to tweak the bsTriangle ButtonStyle of Laz.VirtualStringTree
« Reply #9 on: October 03, 2024, 04:45:23 pm »
Unless I've missed something, here is the final and working version...
Code: Pascal  [Select][+][-]
  1. procedure TMain.PresetTreeAfterItemPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; const ItemRect: TRect);
  2. var
  3.   Level: Cardinal;
  4.   IsSelected: Boolean;
  5.   IsFocused: Boolean;
  6.   IsFocusedNode: Boolean;
  7.   IsExpanded: Boolean;
  8.  
  9.   procedure DrawBackground(Canvas: TCanvas; Selected, Focused: Boolean);
  10.   begin
  11.     if Focused or Selected then
  12.     begin
  13.       Canvas.Pen.Color := PresetTree.Colors.FocusedSelectionColor;
  14.       Canvas.Brush.Color := PresetTree.Colors.FocusedSelectionColor;
  15.     end
  16.     else
  17.     begin
  18.       Canvas.Pen.Color := PresetTree.Colors.UnfocusedColor;
  19.       Canvas.Brush.Color := PresetTree.Colors.UnfocusedColor;
  20.     end;
  21.     Canvas.FillRect(1, 1, 16, 16);
  22.   end;
  23.  
  24.   procedure EraseCategoryOutline(TargetCanvas: TCanvas; Selected, Focused: Boolean);
  25.   begin
  26.     if Focused or Selected then
  27.     begin
  28.       TargetCanvas.Pen.Color := PresetTree.Colors.FocusedSelectionColor;
  29.       TargetCanvas.Frame(0, 0, 200, 18);
  30.     end;
  31.   end;
  32.  
  33.   procedure ErasePresetNameOutline(TargetCanvas: TCanvas; Selected, FocusedNode: Boolean);
  34.   begin
  35.     if FocusedNode then
  36.     begin
  37.       TargetCanvas.Pen.Color := PresetTree.Colors.FocusedSelectionColor;
  38.       TargetCanvas.Frame(0, 0, 200, 18);
  39.     end;
  40.   end;
  41.  
  42.   procedure DrawArrow(Canvas: TCanvas; Expanded, Selected, Focused: Boolean);
  43.   var
  44.     Points: array[0..2] of TPoint;
  45.     ArrowColor: TColor;
  46.   begin
  47.     // Set colors
  48.     if Focused or Selected then
  49.       ArrowColor := PresetTree.Colors.SelectionTextColor
  50.     else
  51.       ArrowColor := PresetTree.Colors.TreeLineColor;
  52.     Canvas.Pen.Color := ArrowColor;
  53.     Canvas.Brush.Color := ArrowColor;
  54.     // Do the actual drawing
  55.     if Expanded then
  56.     begin
  57.       // Down arrow
  58.       Points[0] := Point(6, 5);
  59.       Points[1] := Point(14, 5);
  60.       Points[2] := Point(10, 11);
  61.     end
  62.     else
  63.     begin
  64.       // Right arrow
  65.       Points[0] := Point(6, 4);
  66.       Points[1] := Point(12, 8);
  67.       Points[2] := Point(6, 12);
  68.     end;
  69.     Canvas.Polygon(Points);
  70.   end;
  71.  
  72. begin
  73.   Level := PresetTree.GetNodeLevel(Node);
  74.   if Level = 0 then
  75.   begin
  76.     // Set state flags
  77.     IsSelected := PresetTree.Selected[Node] and PresetTree.Focused;
  78.     IsFocused := (Node = PresetTree.FocusedNode) and PresetTree.Focused;
  79.     IsExpanded := PresetTree.Expanded[Node];
  80.     // Call the drawing nested procedures
  81.     DrawBackground(TargetCanvas, IsSelected, IsFocused);
  82.     DrawArrow(TargetCanvas, IsExpanded, IsSelected, IsFocused);
  83.     EraseCategoryOutline(TargetCanvas, IsSelected, IsFocused);
  84.   end;
  85.   if Level = 1 then
  86.   begin
  87.     IsSelected := PresetTree.Selected[Node] and PresetTree.Focused;
  88.     IsFocusedNode := Node = PresetTree.FocusedNode;
  89.     ErasePresetNameOutline(TargetCanvas, IsSelected, IsFocusedNode);
  90.   end;
  91. end;
  92.  

No doubt it can be further refactored, but that can wait  ;)
"It builds... ship it!"

wp

  • Hero Member
  • *****
  • Posts: 12459
Re: Trying to tweak the bsTriangle ButtonStyle of Laz.VirtualStringTree
« Reply #10 on: October 03, 2024, 04:52:34 pm »
The issue is caused by the way the button bitmap is made transparent. It uses the old method of color-transparency where a specific color is declared as "TransparentColor"; all pixels having this color are not drawn. This works fine as long as semitransparent pixels are not painted due to antialiasing - in these pixels the "pseudo-transparent" background color shines through. This happens along non-horizontal and not-vertical lines. And in fact, the nested procedure FillBitmap in procedure TBaseVirtualTree.PrepareBitmaps sets the bitmap's Brush for the "transparent" background color to clFuchsia. This is the source of the purple line that you see.

The correct way to fix this is to switch to alpha-channel transparency of 32 bit-per-pixel bitmaps. But since color-transparency is used all over the VTV this requires some work. As a quick fix you simply could change in FillBitmap the clFuchsia to ColorToRGB(clWindow). And do not set Transparent and TransparentColor - macOS does not seem to like this (as a consequence you cannot use a background image because this way the tree buttons will not be transparent any more).
« Last Edit: October 03, 2024, 04:57:14 pm by wp »

carl_caulkett

  • Hero Member
  • *****
  • Posts: 649
Re: Trying to tweak the bsTriangle ButtonStyle of Laz.VirtualStringTree
« Reply #11 on: October 03, 2024, 05:14:22 pm »
The issue is caused by the way the button bitmap is made transparent. It uses the old method of color-transparency where a specific color is declared as "TransparentColor"; all pixels having this color are not drawn. This works fine as long as semitransparent pixels are not painted due to antialiasing - in these pixels the "pseudo-transparent" background color shines through. This happens along non-horizontal and not-vertical lines. And in fact, the nested procedure FillBitmap in procedure TBaseVirtualTree.PrepareBitmaps sets the bitmap's Brush for the "transparent" background color to clFuchsia. This is the source of the purple line that you see.

Thanks for the explanation! I did notice the clFuchsia in the code and guessed that it probably had something to do with the lines.

The correct way to fix this is to switch to alpha-channel transparency of 32 bit-per-pixel bitmaps. But since color-transparency is used all over the VTV this requires some work. As a quick fix you simply could change in FillBitmap the clFuchsia to ColorToRGB(clWindow). And do not set Transparent and TransparentColor - macOS does not seem to like this (as a consequence you cannot use a background image because this way the tree buttons will not be transparent any more).

I ended up using a much more 'brute force" method of fixing the problem. It seems quite snappy on my machine but I wonder if it will be more jerky on a slower machine...
"It builds... ship it!"

wp

  • Hero Member
  • *****
  • Posts: 12459
Re: Trying to tweak the bsTriangle ButtonStyle of Laz.VirtualStringTree
« Reply #12 on: October 04, 2024, 08:11:05 pm »
Committed a fix for the transparency issue today to Laz/main. The tree expland/collapse buttons are drawn as alpha-transparent bitmaps now. Seems to work for all widgetsets that I tested (win, cocoa, gtk2, gtk3, qt5). Will be back-ported to Fixes (Laz 3.8)

carl_caulkett

  • Hero Member
  • *****
  • Posts: 649
Re: Trying to tweak the bsTriangle ButtonStyle of Laz.VirtualStringTree
« Reply #13 on: October 04, 2024, 08:19:54 pm »
Cool! I'll check it out. Thanks very much for doing this so quickly 🙏🏽
"It builds... ship it!"

 

TinyPortal © 2005-2018