From e4396f44b82a5a068bc130eccdecf80a1af2f4e8 Mon Sep 17 00:00:00 2001 From: wp_xyz Date: Tue, 18 Feb 2025 19:09:58 +0100 Subject: [PATCH] LCL/TreeView: Make property HideSelection (optionally) Delphi-compatible. Update sample project. --- examples/treeview/customdrawing/main.lfm | 40 ++++++++-- examples/treeview/customdrawing/main.pas | 81 ++++++++++++++++---- lcl/comctrls.pp | 5 ++ lcl/include/treeview.inc | 98 +++++++++++++----------- 4 files changed, 159 insertions(+), 65 deletions(-) diff --git a/examples/treeview/customdrawing/main.lfm b/examples/treeview/customdrawing/main.lfm index 5dcc6aba4e..8e61e577ff 100644 --- a/examples/treeview/customdrawing/main.lfm +++ b/examples/treeview/customdrawing/main.lfm @@ -127,10 +127,10 @@ object MainForm: TMainForm object cbMultiSelect: TCheckBox AnchorSideLeft.Control = cbHideSelection AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = Panel2 - Left = 124 + AnchorSideTop.Control = cbShowLines + Left = 113 Height = 19 - Top = 0 + Top = 50 Width = 81 BorderSpacing.Left = 20 Caption = 'Multi-select' @@ -155,7 +155,7 @@ object MainForm: TMainForm AnchorSideLeft.Control = cbMultiSelect AnchorSideTop.Control = cbShowButtons AnchorSideTop.Side = asrCenter - Left = 124 + Left = 113 Height = 23 Top = 23 Width = 104 @@ -180,14 +180,42 @@ object MainForm: TMainForm Left = 0 Height = 19 Top = 0 - Width = 104 + Width = 93 BorderSpacing.Bottom = 6 - Caption = 'cbHideSelection' + Caption = 'Hide selection' Checked = True State = cbChecked TabOrder = 0 OnChange = cbHideSelectionChange end + object rbHideSelModeLaz: TRadioButton + AnchorSideLeft.Control = cbHideSelection + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = cbHideSelection + Left = 113 + Height = 19 + Top = 0 + Width = 56 + BorderSpacing.Left = 20 + Caption = 'like Laz' + Checked = True + TabOrder = 7 + TabStop = True + OnChange = rbHideSelModeLazChange + end + object rbHideSelModeDelphi: TRadioButton + AnchorSideLeft.Control = rbHideSelModeLaz + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = cbHideSelection + Left = 179 + Height = 19 + Top = 0 + Width = 73 + BorderSpacing.Left = 10 + Caption = 'like Delphi' + TabOrder = 6 + OnChange = rbHideSelModeLazChange + end end end object Splitter1: TSplitter diff --git a/examples/treeview/customdrawing/main.pas b/examples/treeview/customdrawing/main.pas index 44ecdc4ff3..c7acb81939 100644 --- a/examples/treeview/customdrawing/main.pas +++ b/examples/treeview/customdrawing/main.pas @@ -6,7 +6,7 @@ interface uses Classes, ComCtrls, ExtCtrls, SysUtils, Forms, Controls, Graphics, Dialogs, - StdCtrls; + StdCtrls, LCLVersion; type @@ -24,6 +24,8 @@ type lbTask: TListBox; Panel1: TPanel; Panel2: TPanel; + rbHideSelModeLaz: TRadioButton; + rbHideSelModeDelphi: TRadioButton; Splitter1: TSplitter; TreeView: TTreeView; procedure btnToggleEnabledDisabledClick(Sender: TObject); @@ -55,6 +57,7 @@ type // The top-level nodes are painted with bold font procedure BoldTopLevel_CustomDrawItem(Sender: TCustomTreeView; Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean); + procedure rbHideSelModeLazChange(Sender: TObject); // Nodes as rounded rectangles procedure RoundedRectNodes_AdvancedCustomDrawItem(Sender: TCustomTreeView; @@ -362,7 +365,7 @@ var begin if Stage = cdPrePaint then begin - // Draw the image + // Draw the image in a tiled manner y := 0; while (y < TreeView.ClientHeight) do begin @@ -384,14 +387,21 @@ end; procedure TMainForm.BackgroundImage_AdvancedCustomDrawItem(Sender: TCustomTreeView; Node: TTreeNode; State: TCustomDrawState; Stage: TCustomDrawStage; var PaintImages, DefaultDraw: Boolean); +var + hideSel: Boolean; begin + {$IF LCL_FullVersion >= 4990000} + hideSel := TTreeView(Sender).SelectionIsHidden; + {$ELSE} + hideSel := false; + {$ENDIF} case Stage of cdPreErase: // Avoid overwriting the image with the node background color Sender.Canvas.Brush.Color := clNone; cdPostErase: // Avoid drawing the default hottrack node text background over the image - if (cdsSelected in State) then + if (cdsSelected in State) and not hideSel then Sender.Canvas.Brush.Color := clHighlight else if (cdsHot in State) then @@ -416,21 +426,39 @@ begin Sender.Canvas.Font.Style := []; end; -{ Draw nodes as rounded rectangles. } +procedure TMainForm.rbHideSelModeLazChange(Sender: TObject); +begin + {$IF LCL_FullVersion >= 4990000} + if rbHideSelModeLaz.Checked then + TreeView.HideSelectionMode := hsmLaz + else + TreeView.HideSelectionMode := hsmDelphi; + TreeView.Invalidate; + {$IFEND} +end; + +{ Draws nodes as rounded rectangles. } procedure TMainForm.RoundedRectNodes_AdvancedCustomDrawItem(Sender: TCustomTreeView; Node: TTreeNode; State: TCustomDrawState; Stage: TCustomDrawStage; var PaintImages, DefaultDraw: Boolean); var R: TRect; + hideSel: Boolean; begin if Stage = cdPostErase then begin + {$IF LCL_FullVersion >= 4990000} + hideSel := TTreeView(Sender).SelectionIsHidden; + {$ELSE} + hideSel := false; + {$ENDIF} + R := Node.DisplayRect(true); R.Left := Node.DisplayIconLeft; dec(R.Left, 2); inc(R.Top); dec(R.Bottom); - if State * [cdsFocused, cdsSelected] <> [] then + if (State * [cdsFocused, cdsSelected] <> []) and not hideSel then begin Sender.Canvas.Brush.Color := clRed; Sender.Canvas.Pen.Color := clMaroon; @@ -453,7 +481,7 @@ begin end; end; -{ Full row highlighting. Depending on the selection in the Task radiogroup, +{ Full row highlighting. Depending on the selection in the task radiogroup, there are three possibilities: - highlighting across the entire row - highlighting starting at the icon @@ -463,18 +491,25 @@ procedure TMainForm.RowSelectHotTrack_AdvancedCustomDrawItem(Sender: TCustomTree var PaintImages, DefaultDraw: Boolean); var R: TRect; - idx: Integer; + hideSel: Boolean; begin if Stage = cdPostErase then begin - if [cdsFocused, cdsSelected] * State <> [] then // Selected node - Sender.Canvas.Brush.Color := clRed - else + {$IF LCL_FullVersion >= 4990000} + hideSel := TTreeView(Sender).SelectionIsHidden; + {$ELSE} + hideSel := false; + {$ENDIF} + + if ([cdsFocused, cdsSelected] * State <> []) and not hideSel then + begin + Sender.Canvas.Brush.Color := clRed; // Selected node + Sender.Canvas.Font.Color := clWhite; + end else if cdsHot in State then // Hot-tracked node Sender.Canvas.Brush.Color := $ccccff else Sender.Canvas.Brush.Color := clWindow; // Normal nodes - idx := lbTask.ItemIndex; case lbTask.ItemIndex of tRowSelect_HotTrack_Full: // full with of displayed node DefaultDraw := true; @@ -512,15 +547,22 @@ procedure TMainForm.RowSelectHotTrackGradient_AdvancedCustomDrawItem(Sender: TCu var R: TRect; startColor, endColor: TColor; + hideSel: Boolean; begin if Stage = cdPostErase then begin - if [cdsFocused, cdsSelected] * State <> [] then // Selected node - begin + {$IF LCL_FullVersion >= 4990000} + hideSel := TTreeView(Sender).SelectionIsHidden; + {$ELSE} + hideSel := false; + {$ENDIF} + + if ([cdsFocused, cdsSelected] * State <> []) and not hideSel then + begin // Selected node startColor := clRed; endColor := $ccccff; end else - if cdsHot in State then // Hot-tracked node + if cdsHot in State then // Hot-tracked node begin startColor := $ccccff; endColor := clWhite; @@ -562,13 +604,20 @@ procedure TMainForm.SelectHotTrackImage_AdvancedCustomDrawItem(Sender: TCustomTr var PaintImages, DefaultDraw: Boolean); var R: TRect; + hideSel: Boolean; begin if Stage = cdPostErase then begin - if [cdsFocused, cdsSelected] * State <> [] then // Selected node - begin + {$IF LCL_FullVersion >= 4990000} + hideSel := TTreeView(Sender).SelectionIsHidden; + {$ELSE} + hideSel := false; + {$ENDIF} + if ([cdsFocused, cdsSelected] * State <> []) and not hideSel then + begin // Selected node Sender.Canvas.Brush.Style := bsImage; Sender.Canvas.Brush.Bitmap := FSelectionImg.Bitmap; + Sender.Canvas.Font.Color := clWhite; end else if cdsHot in State then // Hot-tracked node begin diff --git a/lcl/comctrls.pp b/lcl/comctrls.pp index 56715531bd..a52b3e7744 100644 --- a/lcl/comctrls.pp +++ b/lcl/comctrls.pp @@ -3422,6 +3422,7 @@ type tvimAsPrevSibling ); + THideSelectionMode = (hsmLaz, hsmDelphi); TCustomTreeView = class(TCustomControl) private @@ -3509,6 +3510,7 @@ type FPrevToolTips: boolean; FDragScrollMargin: integer; FDragScrollTimer: TTimer; + FHideSelectionMode: THideSelectionMode; procedure DragScrollTimerTick(Sender: TObject); procedure CanvasChanged(Sender: TObject); function GetAutoExpand: boolean; @@ -3786,6 +3788,7 @@ type procedure MakeSelectionVisible; procedure ClearInvisibleSelection; function StoreCurrentSelection: TStringList; + function SelectionIsHidden: Boolean; procedure ApplyStoredSelection(ASelection: TStringList; FreeList: boolean = True); procedure MoveToNextNode(ASelect: Boolean = False); procedure MoveToPrevNode(ASelect: Boolean = False); @@ -3831,6 +3834,8 @@ type property TopItem: TTreeNode read GetTopItem write SetTopItem; property TreeLineColor: TColor read FTreeLineColor write FTreeLineColor default clWindowFrame; property TreeLinePenStyle: TPenStyle read FTreeLinePenStyle write FTreeLinePenStyle default psPattern; + // When HideSelection is false, switches between Lazarus (sel nodes gray) and Delphi mode (sel nodes hidden) + property HideSelectionMode: THideSelectionMode read FHideSelectionMode write FHideSelectionMode; published property TabStop default true; end; diff --git a/lcl/include/treeview.inc b/lcl/include/treeview.inc index 87cc968ce1..1e9ae944d0 100644 --- a/lcl/include/treeview.inc +++ b/lcl/include/treeview.inc @@ -5171,7 +5171,7 @@ procedure TCustomTreeView.DoPaintNode(Node: TTreeNode); var NodeRect: TRect; VertMid, VertDelta, RealExpandSignSize, RealIndent: integer; - NodeSelected, NodeHot, NodeDisabled, HasExpandSign, CustomDrawn: boolean; + NodeSelected, NodeHot, NodeDisabled, HasExpandSign, CustomDrawn: Boolean; procedure DrawVertLine(X, Y1, Y2: Integer); begin @@ -5488,6 +5488,24 @@ var end; end; + function GetThemedDetail(IsFocused, IsSelected, IsHot: Boolean): TThemedTreeView; + const + DETAIL: array[boolean, boolean, boolean] of TThemedTreeView = ( + // IsFocused = false + ( { IsHot = false IsHot = true } + { IsSelected = false } ( ttItemNormal, ttItemHot ), + { IsSelected = true } ( ttItemSelectedNotFocus, ttItemSelectedNotFocus ) + ), + // IsFocused = true + ( { IsHot = false IsHot = true } + { IsSelected = false } ( ttItemNormal, ttItemHot ), + { IsSelected = true } ( ttItemSelected, ttItemSelected ) + ) + ); + begin + Result := DETAIL[IsFocused, IsSelected and (not SelectionIsHidden), IsHot]; + end; + { Draws the default normal node background } procedure DrawNormalBackground(ARect: TRect); begin @@ -5498,73 +5516,59 @@ var { Default-draws the background of selected and hot-tracked nodes over the full client width. This does not occur when the tree is not in RowSelect mode, or when the preceding OnAdvancedCustomDrawItem event handler has been - exited with DefaultDraw = fals. } + exited with DefaultDraw = false. } procedure DrawSpecialBackground(IsSelected, IsHot: Boolean; ARect: TRect); var Details: TThemedElementDetails; + tt: TThemedTreeView; begin if not RowSelect then exit; if not (IsSelected or IsHot) then exit; - if tvoThemedDraw in Options then + + if (tvoThemedDraw in Options) then begin - if (tvoFocusedPainting in FStates) then - begin - if IsSelected then - Details := ThemeServices.GetElementDetails(ttItemSelected) - else - if IsHot then - Details := ThemeServices.GetElementDetails(ttItemHot); + tt := GetThemedDetail(Focused, IsSelected, IsHot); + Details := ThemeServices.GetElementDetails(tt); + if tt <> ttItemNormal then ThemeServices.DrawElement(Canvas.Handle, Details, ARect, nil); - end; end else if (IsSelected or IsHot) and (Canvas.Brush.Color <> clNone) then - Canvas.FillRect(ARect); + Canvas.FillRect(ARect); end; - { If not deactivated by user selection in the custom-draw events, draws the - node text background. Then the node text. } - procedure DrawNodeText(IsSelected, IsHot: Boolean; NdRect: TRect; AText: String); + { Draws first the node text background unless deactivated by user selection + in the custom-draw events. Then the node text is drawn. } + procedure DrawNodeText(IsSelected, IsHot: Boolean; ANodeRect: TRect; AText: String); var Details: TThemedElementDetails; + tt: TThemedTreeView; begin - if IsSelected or IsHot then + // Themed drawing here + if tvoThemedDraw in Options then begin - if tvoFocusedPainting in FStates then - begin - if IsSelected then - Details := ThemeServices.GetElementDetails(ttItemSelected) - else - Details := ThemeServices.GetElementDetails(ttItemHot); - end else - Details := ThemeServices.GetElementDetails(ttItemSelectedNotFocus); - if not (tvoRowSelect in Options) then - begin - if (tvoThemedDraw in Options) then - ThemeServices.DrawElement(Canvas.Handle, Details, NdRect, nil) - else - if Canvas.Brush.Color <> clNone then - Canvas.FillRect(NdRect) - end else - if not (tvoThemedDraw in Options) and (Canvas.Brush.Color <> clNone) then - Canvas.FillRect(NdRect); - end - else - Details := ThemeServices.GetElementDetails(ttItemNormal); + tt := GetThemedDetail(Focused, IsSelected, IsHot); + Details := ThemeServices.GetElementDetails(tt); + if (tt <> ttItemNormal) and (not RowSelect) then + ThemeServices.DrawElement(Canvas.Handle, Details, ANodeRect, nil); + end else + // Non-themed drawing of text background here + if not RowSelect and (Canvas.Brush.Color <> clNone) then + Canvas.FillRect(ANodeRect); - NdRect.Offset(ScaleX(2, 96), 0); - - SetBkMode(Canvas.Handle, TRANSPARENT); + // Draw the node text + ANodeRect.Offset(ScaleX(2, 96), 0); if (tvoThemedDraw in Options) then begin if not (Enabled and Node.Enabled) then Details.State := 4; // TmSchema.TREIS_DISABLED = 4 - ThemeServices.DrawText(Canvas, Details, AText, NdRect, DT_LEFT or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX, 0); + ThemeServices.DrawText(Canvas, Details, AText, ANodeRect, DT_LEFT or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX, 0); end else begin - DrawText(Canvas.Handle, PChar(AText), -1, NdRect, DT_LEFT or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX); + SetBkMode(Canvas.Handle, TRANSPARENT); + DrawText(Canvas.Handle, PChar(AText), -1, ANodeRect, DT_LEFT or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX); end; end; @@ -5590,7 +5594,7 @@ begin NodeHot := (tvoHotTrack in FOptions) and (Node = FNodeUnderCursor) and Assigned(FNodeUnderCursor); NodeDisabled := not (Enabled and Node.Enabled); Canvas.Font.Assign(Self.Font); - if NodeSelected and not (tvoThemedDraw in Options) then + if NodeSelected and not (tvoThemedDraw in Options) and not SelectionIsHidden then begin Canvas.Brush.Color := FSelectedColor; Canvas.Font.Color := FSelectedFontColor; @@ -6883,6 +6887,14 @@ begin end; end; +{ When HideSelection is true (and the tree is not focused), the selection is + really hidden only in Delphi mode. Lazarus mode ignores the HideSelection + setting. } +function TCustomTreeView.SelectionIsHidden: Boolean; +begin + Result := (not Focused) and HideSelection and (FHideSelectionMode = hsmDelphi); +end; + procedure TCustomTreeView.MoveToNextNode(ASelect: Boolean); var ANode: TTreeNode;