diff --git a/examples/treeview/customdrawing/main.lfm b/examples/treeview/customdrawing/main.lfm index dba16dd5c3..4a23cf758a 100644 --- a/examples/treeview/customdrawing/main.lfm +++ b/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 diff --git a/examples/treeview/customdrawing/main.pas b/examples/treeview/customdrawing/main.pas index 6f67865cb7..77783b8ec2 100644 --- a/examples/treeview/customdrawing/main.pas +++ b/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 diff --git a/examples/treeview/customdrawing/treeview_customdraw_demo.lpr b/examples/treeview/customdrawing/treeview_customdraw_demo.lpr index 8fd7439b39..a8744b2897 100644 --- a/examples/treeview/customdrawing/treeview_customdraw_demo.lpr +++ b/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}