Delphi component / custom TreeView attributes

Close Index
{ 
	An example of Delphi visual component, descendant of a TreeView component. 
	
	( c. 2003  Igor Klepoch )
}


unit IKTreeView;

interface

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

type
  TTreeID = record
              ID : integer;
            end;
            
  TIKTreeView = class(TDATreeView)
  private
    FTreeFileName: string;
    NewTreeID : integer;
    procedure SetTreeFileName(const Value: string);
    { Private declarations }
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function AddSiblingTree : boolean;
    function  AddChildTree : boolean;
    function DeleteCurrentTree : boolean;
    procedure LoadTree;
    procedure Savetree;
    procedure AddTreeID(Anode: TTreeNode; AId: integer);
    function GetID(Anode: TTreeNode): integer;
    function GetActualID: integer;
    function GetNameByID(SearchTreeID: integer): string;
    function GetNodeByID(SearchTreeID: integer): TTreeNode;
    function IsIDExist(SearchTreeID: integer): boolean;
    function GetNewTreeID : integer;
    function GetAllTreePath (SNode : TTreeNode = nil) : string;
    function GetAllTreePathByID (SearchTreeID: integer) : string;

  published
    { Published declarations }
    property TreeFileName : string read FTreeFileName write SetTreeFileName;
  end;

var
  TreeID : ^TTreeID;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TIKTreeView]);
end;

{ TIKTreeView }

function TIKTreeView.AddChildTree : boolean;
var
  NewItem : string;
begin
  result := false;
  NewItem := InputBox ('Enter new item', '', 'NewItem');
  if (NewItem  > '') and (NewItem <> 'NewItem') then begin
    Selected := Items.AddChild (Selected, NewItem);
    AddTreeID (Selected, GetNewTreeID);
    result := true;
  end;
end;


function TIKTreeView.AddSiblingTree : boolean;
var
  NewItem : string;
begin
  result := false;
  NewItem := InputBox ('Enter new item', '', 'NewItem');
  if (NewItem  > '') and (NewItem <> 'NewItem') then begin
    Selected := Items.Add (Selected, NewItem);
    AddTreeID (Selected, GetNewTreeID);
    result := true;
  end;
end;

constructor TIKTreeView.Create(AOwner: TComponent);
begin
//  inherited;
  inherited Create(AOwner);
end;

function TIKTreeView.DeleteCurrentTree : boolean;
begin
  result := false;
  if assigned(Selected) then
    if MessageDlg('Do you want to delete item ?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then begin
      selected.Delete;
      result := true;
    end;
end;

destructor TIKTreeView.Destroy;
begin
  inherited Destroy;
//  inherited;
end;

procedure TIKTreeView.SetTreeFileName(const Value: string);
begin
  FTreeFileName := Value;
end;

procedure TIKTreeView.AddTreeID(Anode: TTreeNode; AId: integer);
begin
    new(TreeID);
    with TreeID^ do
      ID := AID;
    ANode.Data := TreeID;
end;


procedure TIKTreeView.LoadTree;
var
  ANode : TTreeNode;
  DivPos, AID : integer;
  a : string;
begin
  NewTreeID := 10;
  if TreeFileName = '' then
    exit;
  if not(FileExists (TreeFileName)) then
    exit;
  LoadFromFile (TreeFileName);
  ANode := TopItem;
  if pos ('New_item', ANode.Text) > 0 then begin
    DivPos := pos(' ', ANode.Text);
    NewTreeID := StrToInt(copy(ANode.Text, DivPos + 1, length(ANode.Text)));
    ANode.Delete;
    ANode := TopItem;
  end;
  while assigned(ANode) do begin
    DivPos := pos(' ', ANode.Text);
    if DivPos > 0 then begin
      try
        AID := StrToInt(copy(ANode.Text, 1, DivPos - 1));
        ANode.Text := TRIM(copy(ANode.Text, DivPos, length(ANode.Text)));
      except
        AID := 0;
      end;
      AddTreeID (ANode, AID);
    end else
      AddTreeID (ANode, GetNewTreeID);
    ANode := ANode.GetNext;
  end;
end;

procedure TIKTreeView.Savetree;
var
  ANode : TTreeNode;
  DivPos, AID : integer;
begin
  if TreeFileName = '' then
    exit;
  ANode := Items [0];
  while assigned(ANode) do begin
    if Assigned (ANode.Data) then begin
      TreeID := ANode.Data;
      ANode.text := IntToStr(TreeID.id) + ' ' + ANode.text;
    end;
    ANode := ANode.GetNext;
  end;
  ANode := Items [0];
  Items.Insert (ANode, 'New_item ' + IntToStr(NewTreeID));
  try
    if FileExists (TreeFileName) then
      RenameFile (TreeFileName, 'OdlTree.txt');
    SaveToFile (TreeFileName);
  except
    MessageDlg('Could not save tree file.', mtError, [mbOK], 0);
  end;
end;

function TIKTreeView.GetActualID: integer;
begin
  result := GetID (selected);
end;

function TIKTreeView.GetID(Anode: TTreeNode): integer;
begin
  result := -1;
  if Assigned (ANode) then
    if Assigned (ANode.data) then begin
      TreeID := ANode.data;
      result := TreeID.ID;
    end;
end;


function TIKTreeView.GetNameByID(SearchTreeID: integer): string;
var
  ANode : TTreeNode;
begin
  result := '';
  ANode := TopItem;
  while assigned(ANode) do begin
    if Assigned (ANode.Data) then begin
      TreeID := ANode.data;
      if TreeID.ID = SearchTreeID then begin
        result := ANode.Text; exit;
      end;
    end;
    ANode := ANode.GetNext;
  end;
end;

function TIKTreeView.IsIDExist(SearchTreeID: integer): boolean;
var
  ANode : TTreeNode;
begin
  result := false;
  ANode := TopItem;
  while assigned(ANode) do begin
    if Assigned (ANode.Data) then begin
      TreeID := ANode.data;
      if TreeID.ID = SearchTreeID then begin
        result := true; exit;
      end;
    end;
    ANode := ANode.GetNext;
  end;
end;

function TIKTreeView.GetNewTreeID: integer;
begin
  result := NewTreeID;
  inc (NewTreeID);
end;

function TIKTreeView.GetNodeByID(SearchTreeID: integer): TTreeNode;
var
  ANode : TTreeNode;
begin
  result := nil;
  ANode := TopItem;
  while assigned(ANode) do begin
    if Assigned (ANode.Data) then begin
      TreeID := ANode.data;
      if TreeID.ID = SearchTreeID then begin
        result := ANode; exit;
      end;
    end;
    ANode := ANode.GetNext;
  end;
end;


function TIKTreeView.GetAllTreePath(SNode: TTreeNode): string;
begin
  if SNode = nil then
    SNode := Selected;
  result := '';
  while SNode <> nil do begin
    result := SNode.text + ' - ' + result;
    SNode := SNode.Parent;
  end;
  if Length (Result) > 2 then
    result := copy(result, 1, length(result) - 2);
end;


function TIKTreeView.GetAllTreePathByID(SearchTreeID: integer): string;
var
  ANode : TTreeNode;
begin
  ANode := GetNodeByID (SearchTreeID);
  if ANode = nil then
    result := 'Tree error !!!'
  else
    result := GetAllTreePath (ANode);
end;

end.