Trying to tweak the bsTriangle ButtonStyle of Laz.VirtualStringTree

[carl_caulkett]

* 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?

[carl_caulkett]

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?

[carl_caulkett]

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.  

[carl_caulkett]

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 😉

[carl_caulkett]

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 🤔

[dsiders]

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.

[carl_caulkett]

clMoneyGray is $C0DCC0.

Do you mean:

Code: Pascal  [Select][+][-]

1. clMoneyGreen = TColor($C0DCC0); // BBGGRR byte order

?

It was late! Forgive me 🙏🏽

[carl_caulkett]

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!

[carl_caulkett]

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 

[carl_caulkett]

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 

[wp]

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

[carl_caulkett]

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...

[wp]

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.

[carl_caulkett]

Cool! I'll check it out. Thanks very much for doing this so quickly 🙏🏽