paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-14 17:39:23 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL/TreeView: Make property HideSelection (optionally) Delphi-compatible. Update sample project.

Browse Source
This commit is contained in:
wp_xyz 2025-02-18 19:09:58 +01:00
parent 431f5187f4
commit e4396f44b8
4 changed files with 159 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
examples/treeview/customdrawing/main.lfm
View File

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

81
examples/treeview/customdrawing/main.pas
View File

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

5
lcl/comctrls.pp
View File

@ -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;

98
lcl/include/treeview.inc
View File

@ -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;