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

examples/treeview/customdrawing/main.lfm

@@ -1,21 +1,24 @@
 object MainForm: TMainForm
   Left = 314
-  Height = 548
+  Height = 550
   Top = 130
   Width = 709
   AutoSize = True
   Caption = 'TreeView Custom Drawing'
-  ClientHeight = 548
+  ClientHeight = 550
   ClientWidth = 709
+  Constraints.MinHeight = 500
+  Constraints.MinWidth = 700
   LCLVersion = '4.99.0.0'
   OnCreate = FormCreate
   OnDestroy = FormDestroy
   object TreeView: TTreeView
-    Left = 304
-    Height = 548
+    Left = 305
+    Height = 550
     Top = 0
-    Width = 405
+    Width = 404
     Align = alClient
+    BorderSpacing.Left = 3
     Constraints.MinWidth = 400
     Images = ImageList1
     ReadOnly = True
@@ -23,97 +26,37 @@ object MainForm: TMainForm
     Options = [tvoAutoItemHeight, tvoHideSelection, tvoKeepCollapsedNodes, tvoReadOnly, tvoShowButtons, tvoShowLines, tvoShowRoot, tvoToolTips, tvoThemedDraw]
   end
   object Panel1: TPanel
-    Left = 0
-    Height = 548
-    Top = 0
-    Width = 304
+    Left = 6
+    Height = 538
+    Top = 6
+    Width = 288
     Align = alLeft
     AutoSize = True
+    BorderSpacing.Left = 6
+    BorderSpacing.Top = 6
+    BorderSpacing.Right = 3
+    BorderSpacing.Bottom = 6
     BevelOuter = bvNone
-    ClientHeight = 548
-    ClientWidth = 304
+    ClientHeight = 538
+    ClientWidth = 288
     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
-      AnchorSideLeft.Control = Panel1
-      AnchorSideTop.Control = Panel1
-      AnchorSideRight.Control = lbTask
-      AnchorSideRight.Side = asrBottom
-      Left = 8
+      Left = 0
       Height = 45
-      Top = 8
-      Width = 280
-      Anchors = [akTop, akLeft, akRight]
-      BorderSpacing.Around = 8
+      Top = 0
+      Width = 288
+      Align = alTop
       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
     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
-      AnchorSideLeft.Control = Panel1
-      AnchorSideTop.Control = Label1
-      AnchorSideTop.Side = asrBottom
-      AnchorSideRight.Side = asrBottom
-      Left = 8
-      Height = 321
-      Top = 61
+      Left = 0
+      Height = 400
+      Top = 53
       Width = 288
-      BorderSpacing.Around = 8
+      Align = alClient
+      BorderSpacing.Top = 8
+      BorderSpacing.Bottom = 8
       Items.Strings = (
         'Default (themed)'
         'Default (not themed)'
@@ -121,6 +64,7 @@ object MainForm: TMainForm
         'Default + hot-track (not themed)'
         'Bold top-level nodes'
         'Top-level node gradient'
+        'Rounded rectangles'
         'RowSelect + hot-track (full line)'
         'RowSelect + hot-track (at icon)'
         'RowSelect + hot-track (at text)'
@@ -136,33 +80,106 @@ object MainForm: TMainForm
         'Background gradient (not themed)'
       )
       ItemHeight = 15
-      TabOrder = 4
+      TabOrder = 0
       OnClick = lbTaskClick
     end
-    object cmbExpandSign: TComboBox
-      AnchorSideLeft.Control = lbTask
-      AnchorSideTop.Control = cbShowButtons
-      AnchorSideTop.Side = asrBottom
-      Left = 8
-      Height = 23
-      Top = 411
-      Width = 104
-      BorderSpacing.Top = 2
-      ItemHeight = 15
-      ItemIndex = 0
-      Items.Strings = (
-        'themed sign'
-        '+/- sign'
-        'blank arrow'
-        'filled arrow'
-        '> symbol'
-      )
-      Style = csDropDownList
-      TabOrder = 5
-      Text = 'themed sign'
-      OnChange = cmbExpandSignChange
+    object Panel2: TPanel
+      Left = 0
+      Height = 77
+      Top = 461
+      Width = 288
+      Align = alBottom
+      AutoSize = True
+      BevelOuter = bvNone
+      ClientHeight = 77
+      ClientWidth = 288
+      TabOrder = 1
+      object btnToggleEnabledDisabled: TButton
+        AnchorSideLeft.Control = Panel2
+        AnchorSideTop.Control = cmbExpandSign
+        AnchorSideTop.Side = asrBottom
+        Left = 0
+        Height = 25
+        Top = 52
+        Width = 205
+        AutoSize = True
+        BorderSpacing.Top = 6
+        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
+  object Splitter1: TSplitter
+    Left = 297
+    Height = 550
+    Top = 0
+    Width = 5
+  end
   object ImageList1: TImageList
     Scaled = True
     Left = 390

examples/treeview/customdrawing/main.pas

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

examples/treeview/customdrawing/treeview_customdraw_demo.lpr

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