Marco Web Center

[an error occurred while processing this directive]

Home: Code Repository: Mastering Delphi 6

Chapter 07 - Project CustomNodes

Project Structure

CustomNodes.dpr
program CustomNodes;

uses
  Forms,
  CustNodesForm in 'CustNodesForm.pas' {Form1};

{$R *.res}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.
CustNodesForm.pas
unit CustNodesForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    TreeView1: TTreeView;
    Button1: TButton;
    Label1: TLabel;
    procedure TreeView1CreateNodeClass(Sender: TCustomTreeView;
      var NodeClass: TTreeNodeClass);
    procedure Button1Click(Sender: TObject);
    procedure TreeView1Click(Sender: TObject);
  private
    CurrentNodeClass: TTreeNodeClass;
  public
    procedure AddChildNodes(BaseNode: TTreeNode; nItems: Integer);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type
  TMyNode = class (TTreeNode)
  private
    FExtraCode: Integer;
  protected
    procedure SetExtraCode(const Value: Integer); virtual;
    function GetExtraCode: Integer; virtual;
  public
    property ExtraCode: Integer read
      GetExtraCode write SetExtraCode;
  end;

  TMySubNode = class (TMyNode)
  protected
    function GetExtraCode: Integer; override;
  end;

procedure TForm1.TreeView1CreateNodeClass(Sender: TCustomTreeView;
  var NodeClass: TTreeNodeClass);
begin
  NodeClass := CurrentNodeClass;
end;

{ TMyNode }

function TMyNode.GetExtraCode: Integer;
begin
  Result := FExtraCode;
end;

procedure TMyNode.SetExtraCode(const Value: Integer);
begin
  FExtraCode := Value;
end;

procedure TForm1.AddChildNodes (BaseNode: TTreeNode; nItems: Integer);
var
  MyNode: TMyNode;
  j: Integer;
begin
  for j := 1 to nItems do
  begin
    CurrentNodeClass := TMySubNode;
    MyNode := TreeView1.Items.AddChild (BaseNode,
      'value' + IntToStr (j)) as TMyNode;
    MyNode.ExtraCode := j;
    // recursively add more nodes, up to a given level
    if MyNode.Level <= 5 then
      AddChildNodes(MyNode, Random (5));
  end;
  // let the system update the form
  Application.ProcessMessages;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  MyNode: TMyNode;
  i: Integer;
begin
  Randomize;
  for i := 1 to 5 do
  begin
    CurrentNodeClass := TMyNode;
    MyNode := TreeView1.Items.AddChild (nil,
      'item' + IntToStr (i)) as TMyNode;
    MyNode.ExtraCode := i;
    AddChildNodes(MyNode, Random (5));
  end;
end;

procedure TForm1.TreeView1Click(Sender: TObject);
var
  MyNode: TMyNode;
begin
  MyNode := TreeView1.Selected as TMyNode;
  Label1.Caption := MyNode.Text + ' [' + MyNode.ClassName + '] = ' +
    IntToStr (MyNode.ExtraCode);
end;

{ TMySubNode }

function TMySubNode.GetExtraCode: Integer;
begin
  Result := fExtraCode * (Parent as TMyNode).ExtraCode;
end;

end.
CustNodesForm.dfm
object Form1: TForm1
  Left = 192
  Top = 139
  Width = 497
  Height = 330
  Caption = 'CustomNodes'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 16
    Top = 272
    Width = 377
    Height = 13
    HelpType = htKeyword
    AutoSize = False
    Caption = 'Info'
  end
  object TreeView1: TTreeView
    Left = 16
    Top = 16
    Width = 377
    Height = 249
    Indent = 19
    TabOrder = 0
    OnClick = TreeView1Click
    OnCreateNodeClass = TreeView1CreateNodeClass
  end
  object Button1: TButton
    Left = 400
    Top = 16
    Width = 75
    Height = 25
    Caption = 'Add Nodes'
    TabOrder = 1
    OnClick = Button1Click
  end
end