|
{ 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.