paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-04 01:42:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL/TreeView: Add another sample to the ownerdraw sample project. Improved layout.

Browse Source
This commit is contained in:
wp_xyz 2025-02-10 15:57:58 +01:00
parent 15ab3afbc6
commit 838a85bc8c
3 changed files with 191 additions and 124 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,21 +1,24 @@
object MainForm: TMainForm object MainForm: TMainForm
Left = 314 Left = 314
Height = 548 Height = 550
Top = 130 Top = 130
Width = 709 Width = 709
AutoSize = True AutoSize = True
Caption = 'TreeView Custom Drawing' Caption = 'TreeView Custom Drawing'
ClientHeight = 548 ClientHeight = 550
ClientWidth = 709 ClientWidth = 709
Constraints.MinHeight = 500
Constraints.MinWidth = 700
LCLVersion = '4.99.0.0' LCLVersion = '4.99.0.0'
OnCreate = FormCreate OnCreate = FormCreate
OnDestroy = FormDestroy OnDestroy = FormDestroy
object TreeView: TTreeView object TreeView: TTreeView
Left = 304 Left = 305
Height = 548 Height = 550
Top = 0 Top = 0
Width = 405 Width = 404
Align = alClient Align = alClient
BorderSpacing.Left = 3
Constraints.MinWidth = 400 Constraints.MinWidth = 400
Images = ImageList1 Images = ImageList1
ReadOnly = True ReadOnly = True
@ -23,97 +26,37 @@ object MainForm: TMainForm
Options = [tvoAutoItemHeight, tvoHideSelection, tvoKeepCollapsedNodes, tvoReadOnly, tvoShowButtons, tvoShowLines, tvoShowRoot, tvoToolTips, tvoThemedDraw] Options = [tvoAutoItemHeight, tvoHideSelection, tvoKeepCollapsedNodes, tvoReadOnly, tvoShowButtons, tvoShowLines, tvoShowRoot, tvoToolTips, tvoThemedDraw]
end end
object Panel1: TPanel object Panel1: TPanel
Left = 0 Left = 6
Height = 548 Height = 538
Top = 0 Top = 6
Width = 304 Width = 288
Align = alLeft Align = alLeft
AutoSize = True AutoSize = True
BorderSpacing.Left = 6
BorderSpacing.Top = 6
BorderSpacing.Right = 3
BorderSpacing.Bottom = 6
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 548 ClientHeight = 538
ClientWidth = 304 ClientWidth = 288
TabOrder = 1 TabOrder = 1
object btnToggleEnabledDisabled: TButton
AnchorSideLeft.Control = lbTask
AnchorSideTop.Control = cmbExpandSign
AnchorSideTop.Side = asrBottom
Left = 8
Height = 25
Top = 442
Width = 205
AutoSize = True
BorderSpacing.Top = 8
BorderSpacing.Bottom = 8
Caption = 'Toggle 1st node enabled/disabled'
TabOrder = 0
OnClick = btnToggleEnabledDisabledClick
end
object cbShowLines: TCheckBox
AnchorSideLeft.Control = cbShowButtons
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = cbShowButtons
Left = 119
Height = 19
Top = 390
Width = 74
BorderSpacing.Left = 20
Caption = 'Show lines'
Checked = True
State = cbChecked
TabOrder = 1
OnChange = cbShowLinesChange
end
object cbMultiSelect: TCheckBox
AnchorSideLeft.Control = cbShowLines
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = cbShowLines
Left = 213
Height = 19
Top = 390
Width = 81
BorderSpacing.Left = 20
Caption = 'Multi-select'
TabOrder = 2
OnChange = cbMultiSelectChange
end
object Label1: TLabel object Label1: TLabel
AnchorSideLeft.Control = Panel1 Left = 0
AnchorSideTop.Control = Panel1
AnchorSideRight.Control = lbTask
AnchorSideRight.Side = asrBottom
Left = 8
Height = 45 Height = 45
Top = 8 Top = 0
Width = 280 Width = 288
Anchors = [akTop, akLeft, akRight] Align = alTop
BorderSpacing.Around = 8
Caption = 'Select a drawing task and click on a tree node. '#13#10'To see the hot-track effect move the mouse over some nodes' Caption = 'Select a drawing task and click on a tree node. '#13#10'To see the hot-track effect move the mouse over some nodes'
WordWrap = True WordWrap = True
end end
object cbShowButtons: TCheckBox
AnchorSideLeft.Control = lbTask
AnchorSideTop.Control = lbTask
AnchorSideTop.Side = asrBottom
Left = 8
Height = 19
Top = 390
Width = 91
Caption = 'Show buttons'
Checked = True
State = cbChecked
TabOrder = 3
OnChange = cbShowButtonsChange
end
object lbTask: TListBox object lbTask: TListBox
AnchorSideLeft.Control = Panel1 Left = 0
AnchorSideTop.Control = Label1 Height = 400
AnchorSideTop.Side = asrBottom Top = 53
AnchorSideRight.Side = asrBottom
Left = 8
Height = 321
Top = 61
Width = 288 Width = 288
BorderSpacing.Around = 8 Align = alClient
BorderSpacing.Top = 8
BorderSpacing.Bottom = 8
Items.Strings = ( Items.Strings = (
'Default (themed)' 'Default (themed)'
'Default (not themed)' 'Default (not themed)'
@ -121,6 +64,7 @@ object MainForm: TMainForm
'Default + hot-track (not themed)' 'Default + hot-track (not themed)'
'Bold top-level nodes' 'Bold top-level nodes'
'Top-level node gradient' 'Top-level node gradient'
'Rounded rectangles'
'RowSelect + hot-track (full line)' 'RowSelect + hot-track (full line)'
'RowSelect + hot-track (at icon)' 'RowSelect + hot-track (at icon)'
'RowSelect + hot-track (at text)' 'RowSelect + hot-track (at text)'
@ -136,33 +80,106 @@ object MainForm: TMainForm
'Background gradient (not themed)' 'Background gradient (not themed)'
) )
ItemHeight = 15 ItemHeight = 15
TabOrder = 4 TabOrder = 0
OnClick = lbTaskClick OnClick = lbTaskClick
end end
object cmbExpandSign: TComboBox object Panel2: TPanel
AnchorSideLeft.Control = lbTask Left = 0
AnchorSideTop.Control = cbShowButtons Height = 77
AnchorSideTop.Side = asrBottom Top = 461
Left = 8 Width = 288
Height = 23 Align = alBottom
Top = 411 AutoSize = True
Width = 104 BevelOuter = bvNone
BorderSpacing.Top = 2 ClientHeight = 77
ItemHeight = 15 ClientWidth = 288
ItemIndex = 0 TabOrder = 1
Items.Strings = ( object btnToggleEnabledDisabled: TButton
'themed sign' AnchorSideLeft.Control = Panel2
'+/- sign' AnchorSideTop.Control = cmbExpandSign
'blank arrow' AnchorSideTop.Side = asrBottom
'filled arrow' Left = 0
'> symbol' Height = 25
) Top = 52
Style = csDropDownList Width = 205
TabOrder = 5 AutoSize = True
Text = 'themed sign' BorderSpacing.Top = 6
OnChange = cmbExpandSignChange Caption = 'Toggle 1st node enabled/disabled'
TabOrder = 0
OnClick = btnToggleEnabledDisabledClick
end
object cbShowLines: TCheckBox
AnchorSideLeft.Control = cbShowButtons
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Panel2
Left = 111
Height = 19
Top = 0
Width = 74
BorderSpacing.Left = 20
Caption = 'Show lines'
Checked = True
State = cbChecked
TabOrder = 1
OnChange = cbShowLinesChange
end
object cbMultiSelect: TCheckBox
AnchorSideLeft.Control = cbShowLines
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Panel2
Left = 205
Height = 19
Top = 0
Width = 81
BorderSpacing.Left = 20
Caption = 'Multi-select'
TabOrder = 2
OnChange = cbMultiSelectChange
end
object cbShowButtons: TCheckBox
AnchorSideLeft.Control = Panel2
AnchorSideTop.Control = Panel2
Left = 0
Height = 19
Top = 0
Width = 91
Caption = 'Show buttons'
Checked = True
State = cbChecked
TabOrder = 3
OnChange = cbShowButtonsChange
end
object cmbExpandSign: TComboBox
AnchorSideLeft.Control = Panel2
AnchorSideTop.Control = cbShowLines
AnchorSideTop.Side = asrBottom
Left = 0
Height = 23
Top = 23
Width = 104
BorderSpacing.Top = 4
ItemHeight = 15
ItemIndex = 0
Items.Strings = (
'themed sign'
'+/- sign'
'blank arrow'
'filled arrow'
'> symbol'
)
Style = csDropDownList
TabOrder = 4
Text = 'themed sign'
OnChange = cmbExpandSignChange
end
end end
end end
object Splitter1: TSplitter
Left = 297
Height = 550
Top = 0
Width = 5
end
object ImageList1: TImageList object ImageList1: TImageList
Scaled = True Scaled = True
Left = 390 Left = 390

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

@ -22,6 +22,8 @@ type
Label1: TLabel; Label1: TLabel;
lbTask: TListBox; lbTask: TListBox;
Panel1: TPanel; Panel1: TPanel;
Panel2: TPanel;
Splitter1: TSplitter;
TreeView: TTreeView; TreeView: TTreeView;
procedure btnToggleEnabledDisabledClick(Sender: TObject); procedure btnToggleEnabledDisabledClick(Sender: TObject);
procedure cbMultiSelectChange(Sender: TObject); procedure cbMultiSelectChange(Sender: TObject);
@ -52,6 +54,11 @@ type
procedure BoldTopLevel_CustomDrawItem(Sender: TCustomTreeView; procedure BoldTopLevel_CustomDrawItem(Sender: TCustomTreeView;
Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean); Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
// Nodes as rounded rectangles
procedure RoundedRectNodes_AdvancedCustomDrawItem(Sender: TCustomTreeView;
Node: TTreeNode; State: TCustomDrawState; Stage: TCustomDrawStage;
var PaintImages, DefaultDraw: Boolean);
// Selection and hot-tracked lines // Selection and hot-tracked lines
procedure RowSelectHotTrack_AdvancedCustomDrawItem(Sender: TCustomTreeView; procedure RowSelectHotTrack_AdvancedCustomDrawItem(Sender: TCustomTreeView;
Node: TTreeNode; State: TCustomDrawState; Stage: TCustomDrawStage; Node: TTreeNode; State: TCustomDrawState; Stage: TCustomDrawStage;
@ -71,7 +78,6 @@ type
procedure TopLevelGradient_AdvancedCustomDrawItem(Sender: TCustomTreeView; procedure TopLevelGradient_AdvancedCustomDrawItem(Sender: TCustomTreeView;
Node: TTreeNode; State: TCustomDrawState; Stage: TCustomDrawStage; Node: TTreeNode; State: TCustomDrawState; Stage: TCustomDrawStage;
var PaintImages, DefaultDraw: Boolean); var PaintImages, DefaultDraw: Boolean);
private private
FBackImg, FSelectionImg, FHotTrackImg: TPicture; FBackImg, FSelectionImg, FHotTrackImg: TPicture;
procedure PopulateTree; procedure PopulateTree;
@ -94,19 +100,20 @@ const
tDefault_HotTrack_NotThemed = 3; tDefault_HotTrack_NotThemed = 3;
tTopLevelBold = 4; tTopLevelBold = 4;
tTopLevelGradient = 5; tTopLevelGradient = 5;
tRowSelect_HotTrack_Full = 6; tRoundRectNodes = 6;
tRowSelect_HotTrack_Icon = 7; tRowSelect_HotTrack_Full = 7;
tRowSelect_HotTrack_Text = 8; tRowSelect_HotTrack_Icon = 8;
tRowSelect_HotTrack_Gradient_Full = 9; tRowSelect_HotTrack_Text = 9;
tRowSelect_HotTrack_Gradient_Icon = 10; tRowSelect_HotTrack_Gradient_Full = 10;
tRowSelect_HotTrack_Gradient_Text = 11; tRowSelect_HotTrack_Gradient_Icon = 11;
tRowSelect_HotTrack_Gradient_TextOnly = 12; tRowSelect_HotTrack_Gradient_Text = 12;
tSelectHotTrack_Image = 13; tRowSelect_HotTrack_Gradient_TextOnly = 13;
tBackgroundImage_Themed = 14; tSelectHotTrack_Image = 14;
tBackgroundImage_NotThemed = 15; tBackgroundImage_Themed = 15;
tBackgroundImage_Themed_NoHotTrackIcons = 16; tBackgroundImage_NotThemed = 16;
tBackgroundGradient_Themed = 17; tBackgroundImage_Themed_NoHotTrackIcons = 17;
tBackgroundGradient_NotThemed = 18; tBackgroundGradient_Themed = 18;
tBackgroundGradient_NotThemed = 19;
procedure TMainForm.FormCreate(Sender: TObject); procedure TMainForm.FormCreate(Sender: TObject);
begin begin
@ -234,6 +241,12 @@ begin
TreeView.OnAdvancedCustomDrawItem := @TopLevelGradient_AdvancedCustomDrawItem; TreeView.OnAdvancedCustomDrawItem := @TopLevelGradient_AdvancedCustomDrawItem;
end; end;
tRoundRectNodes:
begin
TreeView.Options := TreeView.Options - [tvoThemedDraw] + [tvoHotTrack];
TreeView.OnAdvancedCustomDrawItem := @RoundedRectNodes_AdvancedCustomDrawItem;
end;
tRowSelect_HotTrack_Full, tRowSelect_HotTrack_Full,
tRowSelect_HotTrack_Icon, tRowSelect_HotTrack_Icon,
tRowSelect_HotTrack_Text: tRowSelect_HotTrack_Text:
@ -312,7 +325,7 @@ begin
case Stage of case Stage of
cdPreErase: cdPreErase:
// Avoid overwriting the gradient with the node background color // Avoid overwriting the gradient with the node background color
Sender.Canvas.Brush.Color := clNone; DefaultDraw := false;
cdPostErase: cdPostErase:
// Set selected and hot-track color as usual // Set selected and hot-track color as usual
if ([cdsFocused, cdsSelected] * State <> []) then if ([cdsFocused, cdsSelected] * State <> []) then
@ -388,6 +401,43 @@ begin
Sender.Canvas.Font.Style := []; Sender.Canvas.Font.Style := [];
end; end;
{ Draw nodes as rounded rectangles. }
procedure TMainForm.RoundedRectNodes_AdvancedCustomDrawItem(Sender: TCustomTreeView;
Node: TTreeNode; State: TCustomDrawState; Stage: TCustomDrawStage;
var PaintImages, DefaultDraw: Boolean);
var
R: TRect;
begin
if Stage = cdPostErase then
begin
R := Node.DisplayRect(true);
R.Left := Node.DisplayIconLeft;
dec(R.Left, 2);
inc(R.Top);
dec(R.Bottom);
if State * [cdsFocused, cdsSelected] <> [] then
begin
Sender.Canvas.Brush.Color := clRed;
Sender.Canvas.Pen.Color := clMaroon;
end else
if (cdsHot in State) then
begin
Sender.Canvas.Brush.Color := clMoneyGreen;
Sender.Canvas.Pen.Color := clGreen;
Sender.Canvas.Font.Style := [];
end else
begin
Sender.Canvas.Brush.Color := clBtnFace;
Sender.Canvas.Pen.Color := clSilver;
end;
Sender.Canvas.RoundRect(R, 12, 12);
// Avoid default drawing of the node background
Sender.Canvas.Brush.Style := bsClear;
DefaultDraw := false;
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: there are three possibilities:
- highlighting across the entire row - highlighting across the entire row

2
examples/treeview/customdrawing/treeview_customdraw_demo.lpr
View File

@ -17,7 +17,7 @@ uses
begin begin
RequireDerivedFormResource := True; RequireDerivedFormResource := True;
Application.Scaled := True; Application.Scaled:=True;
{$PUSH}{$WARN 5044 OFF} {$PUSH}{$WARN 5044 OFF}
Application.MainFormOnTaskbar := True; Application.MainFormOnTaskbar := True;
{$POP} {$POP}