Solved: load/save ado into/from treeview

listening . . .
(i have already done it,
will post my project-source this evening->~12hours)

1.here is my Test code(not completed):
unit DBDM;

interface

uses
SysUtils, Classes, DB, ADODB;

type
TQueryDM = class(TDataModule)
ADOConnection: TADOConnection;
adListQuery: TADOQuery;
//the sql is :select * from cat order by
// parent_id,cat_id
adTempQuery: TADOQuery;
private
{ Private declarations }
public
{ Public declarations }
procedure ListQueryOpen;
procedure ListQueryClose;
function GetRecordCount: Integer;
procedure GetNextRecord;
function GetCatName: string;
function GetCatNode: string;
function GetParentID: Integer;
function GetID: Integer;overload;
function GetID(Name: string; Node: Integer): Integer;overload;
function GetMaxNode(ParentID: Integer): Integer;
procedure SetCatName(NewName: string);
procedure SetCatNode(NewNode: Integer);
procedure SetParentID(NewID: Integer);
function SaveRecord: Boolean;
end;

var
QueryDM: TQueryDM;

implementation

{$R *.dfm}

{ TQueryDM }

procedure TQueryDM.ListQueryOpen;
begin
adListQuery.Open;
end;

procedure TQueryDM.ListQueryClose;
begin
adListQuery.Close;
end;

function TQueryDM.GetRecordCount: Integer;
begin
Result := adListQuery.RecordCount;
end;

procedure TQueryDM.GetNextRecord;
begin
adListQuery.Next;
end;

function TQueryDM.GetCatName: string;
begin
Result := adListQuery.FieldByName('Cat_Name').AsString;
end;

function TQueryDM.GetCatNode: string;
begin
Result := adListQuery.FieldByName('Node_Order').AsString;
end;

function TQueryDM.GetParentID: Integer;
begin
Result := adListQuery.FieldByName('Parent_ID').AsInteger;
end;

function TQueryDM.GetID: Integer;
begin
Result := adListQuery.FieldByName('Cat_ID').AsInteger;
end;

function TQueryDM.GetID(Name: string; Node: Integer): Integer;
begin
//Result := adListQuery.FieldByName('Cat_ID').AsInteger;
end;

function TQueryDM.GetMaxNode(ParentID: Integer): Integer;
var
SQLString : string;
begin
SQLString := 'select max(Node_Order) maxnode from cat where Parent_Id='
+ QuotedStr(IntToStr(ParentID));
adTempQuery.Close;
adTempQuery.SQL.Clear;
adTempQuery.SQL.Add(SQLString);
try
adTempQuery.Open;
Result := adTempQuery.FieldByName('maxnode').AsInteger;
except
adTempQuery.Close;
end;
end;

procedure TQueryDM.SetCatName(NewName: string);
begin
adListQuery.FieldByName('Cat_Name').Value := NewName;
end;

procedure TQueryDM.SetCatNode(NewNode: Integer);
begin
adListQuery.FieldByName('Node_Order').Value := NewNode;
end;

procedure TQueryDM.SetParentID(NewID: Integer);
begin
adListQuery.FieldByName('Parent_ID').Value := NewID;
end;

function TQueryDM.SaveRecord: Boolean;
begin
adListQuery.Post;
end;

end.

unit ListForm;

interface

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

type
TForm1 = class(TForm)
TreeView1: TTreeView;
LoadBtn: TButton;
Label1: TLabel;
procedure FormCreate(Sender: TObject);
procedure LoadBtnClick(Sender: TObject);
private
{ Private declarations }
procedure LoadToTreeView;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

uses DBDM;

{$R *.dfm}

{ TForm1 }

procedure TForm1.LoadToTreeView;
var
I, Count : Integer;
TempNode : array of TTreeNode;
ChildNo, ParentNo : Integer;
begin
Count := QueryDM.GetRecordCount;
SetLength(TempNode, Count + 1);
TreeView1.Items.Clear;

TempNode[0] := TreeView1.Items.Add(nil, 'root');
for I:=0 to Count-1 do//Iterate
begin
ChildNo := QueryDM.GetID;
ParentNo := QueryDM.GetParentID;
TempNode[ChildNo] := TreeView1.Items.AddChild(TempNode[ParentNo], QueryDM.GetCatName);
QueryDM.GetNextRecord;
end;//for
SetLength(TempNode, 0);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
QueryDM.ListQueryOpen;
end;

procedure TForm1.LoadBtnClick(Sender: TObject);
begin
LoadToTreeView;
end;

program ADOTreeNode;

uses
Forms,
ListForm in 'ListForm.pas' {Form1},
DBDM in 'DBDM.pas' {QueryDM: TDataModule};

{$R *.res}

begin
Application.Initialize;
Application.CreateForm(TQueryDM, QueryDM);
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

2.TreeNode DragDrop
procedure TForm1.Treeview1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if ( Button = mbLeft ) and
( htOnItem in Treeview1.GetHitTestInfoAt( X, Y ) ) then
begin
Treeview1.BeginDrag( False );
end;
end;

procedure TForm1.Treeview1DragOver( Sender, Source: TObject;
X, Y: Integer; State: TDragState; var Accept: Boolean);
var
Node : TTreeNode;
begin
if Source = Treeview1 then
begin
Node := Treeview1.GetNodeAt( X, Y ); //get currently Node;
if Node <> nil then //selected Node not null then
//accept:=true
Accept := true;
end;

procedure TForm1.Treeview1DragDrop( Sender, Source: TObject;
X, Y : Integer );
var
TempNode : TTreeNode;
AttachMode : TNodeAttachMode;
begin
if Treeview1.Selected = nil then
Exit;
AttachMode := naAddChild; //Set MoveNode Mode
//Note: there have a bug, if target Node have no child
//will can't add the new node, so add a temp node to
//target node, after completed, delete temp node.
try
TempNode := Treeview1.Items.AddChild( Treeview1.DropTarget,
'Temp' );
try

Treeview1.Selected.MoveTo( Treeview1.DropTarget, AttachMode );
finally
TempNode.Free;
end;
finally
Treeview1.Items.EndUpdate;
end;
end;

3.use GetID, SetName, SetNode, SetParentID...etc function to save change record.

smurff

listening

kretzschmar

? sundayboys

procedure TForm1.LoadToTreeView;
var
I, Count : Integer;
TempNode : array of TTreeNode;
ChildNo, ParentNo : Integer;
begin
Count := QueryDM.GetRecordCount;
SetLength(TempNode, Count + 1);
TreeView1.Items.Clear;

TempNode[0] := TreeView1.Items.Add(nil, 'root');
for I:=0 to Count-1 do//Iterate
begin
ChildNo := QueryDM.GetID;
ParentNo := QueryDM.GetParentID;
TempNode[ChildNo] := TreeView1.Items.AddChild(TempNode[ParentNo], QueryDM.GetCatName);
QueryDM.GetNextRecord;
end;//for
SetLength(TempNode, 0);
end;

if i read this correct,
then u are assuming that the ID if your dataset
is not larger than the counts of records

if so,
then this may work only with good will

meikl ;-)

kretzschmar

in the meanwhile i have the load reimplemented,
just as suggestion

unit loadtree_u;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, DB, Mask, DBCtrls, ADODB, ComCtrls;

type
TForm1 = class(TForm)
ADOConnection1: TADOConnection;
ADOQuery1: TADOQuery;
TreeView1: TTreeView;
ADOTable1: TADOTable; //Here are done the Changes
ADOTable1Id: TAutoIncField;
ADOTable1Id_Parent: TIntegerField;
ADOTable1Description: TWideStringField;
ADOTable1Value: TIntegerField;
Label1: TLabel;
DBEdit1: TDBEdit;
DataSource1: TDataSource;
Label2: TLabel;
DBEdit2: TDBEdit;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure TreeView1Change(Sender: TObject; Node: TTreeNode);
private
Procedure Load_Tree; //Load the Tree, also use for Refresh_Tree
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

Type
PDataCacheRecord = ^TDataCacheRecord;
TDataCacheRecord = Record
ID : Integer;
PID : Integer;
Text: String[50];
end;

function FindParent(ATreeView : TTreeView; ID : Integer) : TTreeNode;
var i : integer;
begin
result := nil;
i := 0;
while (i < ATreeView.Items.Count) and
(assigned(ATreeView.Items[i].Data)) and
(PDataCacheRecord(ATreeView.Items[i].Data)^.ID <> ID) do
inc(i);
if i < ATreeView.Items.Count then
result := ATreeView.Items[i];
end;

Procedure TForm1.Load_Tree;
var
ANode : TTreeNode;
RecordCache : PDataCacheRecord;
RecordCacheList : TList;
I, PreviousCount : Integer;
begin
TreeView1.Items.Clear;
ADOQuery1.Close;
ADOQuery1.SQL.Text := 'Select ID, ID_Parent, Description from Tree_Table Order by Id_Parent';
RecordCacheList := TList.Create;
try
ADOQuery1.Open;
//Cache Data
while not ADOQuery1.Eof do
begin
RecordCache := New(PDataCacheRecord);
RecordCache^.ID := ADOQuery1.FieldByName('ID').AsInteger;
RecordCache^.PID := ADOQuery1.FieldByName('ID_Parent').AsInteger;
RecordCache^.Text := ADOQuery1.FieldByName('Description').AsString;
RecordCacheList.Add(RecordCache);
ADOQuery1.Next;
end;
ADOQuery1.Close;
//Adding Roots
PreviousCount := RecordCacheList.Count;
i := 0;
While i < RecordCacheList.Count do
begin
If PDataCacheRecord(RecordCacheList.Items[i])^.PID = 0 then //RootEntry
begin
ANode := TreeView1.Items.AddChild(NIL,PDataCacheRecord(RecordCacheList.Items[i])^.Text);
ANode.Data := RecordCacheList.Items[i];
RecordCacheList.Delete(i);
end
else inc(i);
end;
//Adding Childs
//Loop until there is nothing or it is never reduced -> inkonsistence
While (RecordCacheList.Count > 0) and (PreviousCount <> RecordCacheList.Count) do
begin
i := 0;
PreviousCount := RecordCacheList.Count;
while i < RecordCacheList.Count do
begin
ANode := FindParent(TreeView1,PDataCacheRecord(RecordCacheList.Items[i])^.PID);
if Anode <> NIL then
begin
ANode := TreeView1.Items.AddChild(ANode,PDataCacheRecord(RecordCacheList.Items[i])^.Text);
ANode.Data := RecordCacheList.Items[i];
RecordCacheList.Delete(i);
end
else inc(i);
end;
end;
if RecordCacheList.Count > 0 then
raise exception.Create('Data-Inkonsistence Detected!');
finally
RecordCacheList.Free;
end;
end;

//Load
procedure TForm1.Button1Click(Sender: TObject);
begin
ADOTable1.Close;
Load_Tree;
ADOTable1.Open;
TreeView1.Selected := TreeView1.TopItem;
end;

//Navigate
procedure TForm1.TreeView1Change(Sender: TObject; Node: TTreeNode);
begin
ADOTable1.Locate('ID',PDataCacheRecord(Node.Data)^.ID,[]);
end;

end.

meikl ;-)

kretzschmar

some minor changes

//Navigate
procedure TForm1.TreeView1Change(Sender: TObject; Node: TTreeNode);
begin
if ADOTable1.Active then
ADOTable1.Locate('ID',PDataCacheRecord(Node.Data)^.ID,[]);
end;

//avoid memoryLeak
procedure TForm1.TreeView1Deletion(Sender: TObject; Node: TTreeNode);
begin
If assigned(Node.Data) then
Dispose(PDataCacheRecord(Node.Data));
end;

meikl ;-)

kretzschmar

well, here comes my projectsource-partial
(using lischke's virtuelTree and bde-Datasets
but this can be simple replaced with associated ado-components)

the tree is based on two tables (folders and items)
the items itself cotrols also some sublevel tables

<------------------ Types and Vars

//Data attached to each Node
Type PItemInfo = ^TItemInfo;
TItemInfo = Record
Typ : Integer;
ID : Integer;
PID : Integer;
Name : String[50];
end;

//type of the table, where the data comes from
const Treetype : Array[0..1] of String = ('Arbeitsganggruppe','Arbeitsgang');

//a working item
Var ItemInfo : PItemInfo;

<------------------ Loading

//FindParent
Function TF_AG.FindParent(Tree : TVirtualStringTree; ID,TYP : Integer) : PVirtualNode;
var I : Integer;
Node : PVirtualNode;
AData : PItemInfo;
found : Boolean;
begin
Result := Nil;
Node := Tree.GetFirstNode;
found := False;
while (Node <> nil) and not(found) do
begin
Adata := Tree.GetNodeData(Node);
found := (AData.ID = ID) and
(AData.Typ = Typ);
if not Found then
Node := Tree.GetNext(Node);
end;
If found then
result := Node;
end;

procedure TF_AG.SB_RefreshClick(Sender: TObject);
var
PForm : TfrmProgress; //a progess showing form
PCount : Integer;
SNode,ANode : PVirtualNode;
List : TList;
I : Integer;
SCount : Integer;
SData,AData : PItemInfo;
begin
PForm := TfrmProgress.Create(Self);
TreeView1.BeginUpdate;
if Assigned(Parent) then
Parent.Enabled := False;
try
Q_Count.SQL.Text := 'Select Count(AGG_ID) From AGG';
Try
Q_Count.Prepare;
Q_Count.Open;
PCount := Q_Count.Fields[0].AsInteger;
Q_Count.Close;
except
Raise;
end;
PForm.ProgressBar1.Max := PCount;
PForm.ProgressBar1.Position := 0;
PForm.ProgressBar1.Step := 1;
PForm.Label1.Caption := 'Lade Gruppen f|r Arbeitsgdnge';
Application.ProcessMessages;
PForm.Show;
FTreeInsert := True;
TreeView1.Clear;
List := TList.Create;
Try
//Caching Information->FolderTable
Q_AGG.SQL.Text := 'Select AGG_ID,AGG_PID,AGG_NAME from AGG order by AGG_PID,AGG_NAME';
Q_AGG.Prepare;
try
Q_AGG.Open;
except
raise;
end;
While Not Q_AGG.Eof do
Begin
New(ItemInfo);
ItemInfo^.Typ := 0;
ItemInfo^.ID := Q_AGG.FieldByName('AGG_ID').AsInteger;
If Q_AGG.FieldByName('AGG_PID').IsNull then
ItemInfo^.PID := -1
else
ItemInfo^.PID := Q_AGG.FieldByName('AGG_PID').AsInteger;
ItemInfo^.Name := Q_AGG.FieldByName('AGG_NAME').AsString;
List.Add(ItemInfo);
Q_AGG.Next;
PForm.ProgressBar1.StepIt;
End;
Q_AGG.Close;
//Add Roots First
I := 0;
PForm.ProgressBar1.Max := PCount;
PForm.ProgressBar1.Position := 0;
PForm.ProgressBar1.Step := 1;
PForm.Label1.Caption := 'Ordne Gruppen f|r Arbeitsgdnge';
Application.ProcessMessages;
While I < List.Count do
Begin
If PItemInfo(List[i])^.PID = -1 then
begin

ANode := TreeView1.AddChild(NIL);
AData := TreeView1.GetNodeData(ANode);
AData.ID := PItemInfo(List[I])^.ID;
AData.PID := PItemInfo(List[I])^.PID;
AData.Typ := PItemInfo(List[I])^.Typ;
AData.Name := PItemInfo(List[I])^.Name;
try
Dispose(PItemInfo(List[i]));
except
end;
List.Delete(i);

PForm.ProgressBar1.StepIt;
end
else inc(i);
end;
//Add Rest of Group
While List.Count > 0 do
Begin
SCount := List.Count;
I := 0;
While I < List.Count do
Begin
ANode := FindParent(TreeView1,PItemInfo(List[i])^.PID,0);
If ANode <> Nil then
Begin
ANode := TreeView1.AddChild(ANode);
AData := TreeView1.GetNodeData(ANode);
AData.ID := PItemInfo(List[I])^.ID;
AData.PID := PItemInfo(List[I])^.PID;
AData.Typ := PItemInfo(List[I])^.Typ;
AData.Name := PItemInfo(List[I])^.Name;
try
Dispose(PItemInfo(List[i]));
except
end;
List.Delete(i);
PForm.ProgressBar1.StepIt;
end
else inc(i);
end;
//Konnte nichts mehr zugeordnet werden,
//und es liegen noch Eintrdge vor,
//dann kann was nicht stimmen
If List.Count = SCount then
Raise Exception.Create('Es liegt ein Dateninkonsistenz vor!'+#10+'Benachrichtigen Sie den Entwickler!');
end;
finally
List.Free;
end;
//ItemTable
//Nun zu den Nicht-Gruppen Eintrdgen
i := 0;
Q_Count.SQL.Text := 'Select Count(AG_ID) From AG';
Try
Q_Count.Prepare;
Q_Count.Open;
PCount := Q_Count.Fields[0].AsInteger;
Q_Count.Close;
except
Raise;
end;
PForm.ProgressBar1.Max := PCount;
PForm.ProgressBar1.Position := 0;
PForm.ProgressBar1.Step := 1;
PForm.Label1.Caption := 'Lade und Ordne Items f|r Arbeitsgdnge';
Application.ProcessMessages;
Q_AG.Open;
try
While Not Q_AG.Eof do
begin
SNode := FindParent(TreeView1,Q_AG.FieldByName('AG_AGG_ID').AsInteger,0);
if assigned(SNode) then
begin
ANode := TreeView1.AddChild(SNode);
AData := TreeView1.GetNodeData(ANode);
AData.Typ := 1;
AData.ID := Q_AG.FieldByName('AG_ID').AsInteger;
AData.PID := 0;
AData.Name := Q_AG.FieldByName('AG_NAME').AsString;
PForm.ProgressBar1.StepIt;
end
else
Raise Exception.Create('Es liegt ein Dateninkonsistenz vor!'+#10+'Benachrichtigen Sie den Entwickler (2)!');
Q_AG.Next;
end;
finally
Q_AG.Close;
end;
FTreeInsert := False;
TreeView1.FullCollapse;
If TreeView1.GetFirstNode <> Nil then
begin
TreeView1.Selected[TreeView1.GetFirstNode] := True;
TreeView1.FocusedNode := TreeView1.GetFirstNode;
end;
FAG_EditContext := AGG;
FAG_EditState := AG_Browse;
AdJustNav;
finally
if Assigned(Parent) then
Parent.Enabled := True;
TreeView1.EndUpdate;
PForm.Release;
Application.ProcessMessages;
end;
end;

<--------------------------- Navigate

procedure TF_AG.TreeView1FocusChanged(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: Integer);
var AData : PItemInfo;
begin
AData := TreeView1.GetNodeData(Node);
If Not (FTreeInsert) and (Node <> NIL) and (AData <> Nil) then
begin
Case AData.Typ of
0 : Begin
if fr_agg1.Tbl_AGG.State = dsBrowse then
begin
Tab_AG.Hide;
fr_AGg1.Tbl_AGG.SetKey;
fr_agg1.Tbl_AGG.FieldByName('AGG_ID').AsInteger := AData.ID;
if fr_agg1.Tbl_AGG.GotoKey then
begin
fr_agg1.Align := alClient;
Tab_AGG.Show;
end
else
begin
messagedlg('AGG Satz nicht gefunden:'+#10+
TreeType[AData.Typ]+' "'+
AData.Name+'"'+#10+'Datenrefresh wird durchgef|hrt!',
mtInformation, [mbOK], 0);
SB_Refresh.Click;
end;
end;
End;
1 : Begin
if fr_ag1.Tbl_ag.State = dsBrowse then
begin
Tab_AGG.Hide;
fr_ag1.Tbl_ag.SetKey;
fr_ag1.Tbl_ag.FieldByName('AG_ID').AsInteger := AData.ID;
if fr_ag1.Tbl_ag.GotoKey then
begin
fr_ag1.Align := alClient;
Tab_ag.Show;
end
else
begin
messagedlg('AG Satz nicht gefunden:'+#10+
TreeType[AData.Typ]+' "'+
AData.Name+'"'+#10+'Datenrefresh wird durchgef|hrt!',
mtInformation, [mbOK], 0);
SB_Refresh.Click;
end;
end;
End;
end;
If Assigned(Node) then
begin
Treeview1.Selected[Node] := True;
Panel4.Caption := TreeType[AData.Typ]+' "'+
AData.Name+'"';
end
else
Panel4.Caption := '';
FAG_EditContext := TAG_EditContext(AData.Typ);
AdJustNav;
end;
end;

<-------------------------- Editing

//Insert on Same Level as current Node
procedure TF_AG.SB_InsertSameLevelClick(Sender: TObject);
Var
ANode : PVirtualNode;
AData : PItemInfo;
begin
FTreeInsert := True;
ANode := TreeView1.AddChild(TreeView1.GetFirstSelected.Parent);
AData := TreeView1.GetNodeData(ANode);
AData.ID := 0;
AData.Typ := 0;
AData.PID := 0;
AData.Name := 'Neue Gruppe';
TreeView1.Selected[ANode] := True;
TreeView1.FocusedNode := TreeView1.GetFirstNode;
TreeView1.ScrollIntoView(ANode,True);
FAG_EditContext := AGG;
FAG_EditState := AG_Insert;
AdJustNav;
fr_agg1.TBL_AGG.Insert;
fr_agg1.TBL_AGG.FieldByName('AGG_NAME').AsString := 'Neue Gruppe';
Tab_AG.Hide;
fr_AGG1.Align := alClient;
Tab_AGG.Show;
FTreeInsert := False;
end;

//prefill edit-Dataset
procedure TF_AG.Tbl_AGGAfterInsert(DataSet: TDataSet);
Var
AData : PItemInfo;
ANode : PVirtualNode;
begin
fr_AGg1.Tbl_AGG.FieldByName('AGG_ID').AsInteger := -1;
ANode := TreeView1.GetFirstSelected;
If TreeView1.GetNodeLevel(ANode) = 0 then
fr_agg1.Tbl_AGG.FieldByName('AGG_PID').Clear
else
begin
AData := TreeView1.GetNodeData(TreeView1.GetFirstSelected.Parent);
fr_agg1.Tbl_AGG.FieldByName('AGG_PID').AsInteger := AData.ID;
end;
end;

//adjust Node-Text if Changed
procedure TF_AG.DBEdit1Change(Sender: TObject);
var AData : PItemInfo;
begin
if (fr_AGg1.Tbl_AGG.State = dsEdit) or
(fr_AGg1.Tbl_AGG.State = dsInsert) then
begin
AData := TreeView1.GetNodeData(TreeView1.GetFirstSelected);
AData.Name := fr_agg1.DBEdit1.Text;
Panel4.Caption := TreeType[AData.Typ]+' "'+
AData.Name+'"';
TreeView1.Refresh;
end;
end;

//Save Changes
procedure TF_AG.SB_PostClick(Sender: TObject);
var
AData : PItemInfo;
BM : TBookmark;
begin
if assigned(Parent.Parent) then
Parent.Parent.Enabled := False;
try
Case FAG_EditContext of
AGG : Begin
try
fr_AGg1.Tbl_AGG.Post;

AData := TreeView1.GetNodeData(TreeView1.GetfirstSelected);
AData.Typ := 0;
AData.ID := fr_agg1.Tbl_AGG.FieldByName('AGG_ID').AsInteger;
AData.NAME := fr_agg1.Tbl_AGG.FieldByName('AGG_NAME').AsString;
If fr_agg1.Tbl_AGG.FieldByName('AGG_PID').IsNull then
AData.PID := -1
else
AData.PID := fr_agg1.Tbl_AGG.FieldByName('AGG_PID').AsInteger;
FAG_EditContext := AGG;
FAG_EditState := AG_Browse;
except
Raise;
end;
End;
AG : Begin
try
fr_ag1.Tbl_AG.Post;
AData := TreeView1.GetNodeData(TreeView1.GetfirstSelected);
AData.Typ := 1;
AData.ID := fr_ag1.Tbl_AG.FieldByName('AG_ID').AsInteger;
AData.NAME := fr_ag1.Tbl_AG.FieldByName('AG_NAME').AsString;
AData.PID := 0;
FAG_EditContext := AG;
FAG_EditState := AG_Browse;
except
Raise;
end;
Panel4.Caption := TreeType[AData.Typ]+' "'+
fr_ag1.tbl_ag.FieldByName('AG_Name').AsString+'"';
End;
AGPR : Begin
try
fr_ag1.tbl_agpr.Post;
FAG_EditState := AG_Browse;
fr_ag1.AdJustButtons;
except
Raise;
end;
End;
End;
finally
if assigned(Parent.Parent) then
parent.Parent.Enabled := True;
end;
AdJustNav;
end;

//Insert a ChildNode
procedure TF_AG.SB_InsertSubLevelClick(Sender: TObject);
Var
ANode : PVirtualNode;
AData,PData : PItemInfo;
begin
FTreeInsert := True;
ANode := TreeView1.AddChild(TreeView1.GetFirstSelected);
AData := TreeView1.GetNodeData(ANode);
AData.ID := 0;
AData.Typ := 0;
PData := TreeView1.GetNodeData(TreeView1.GetFirstSelected);
AData.PID := PData.ID;
AData.Name := 'Neue Gruppe';
TreeView1.Selected[ANode] := True;
TreeView1.FocusedNode := TreeView1.GetFirstNode;
TreeView1.ScrollIntoView(ANode,True);
FAG_EditContext := AGG;
FAG_EditState := AG_Insert;
AdJustNav;
fr_agg1.TBL_AGG.Insert;
fr_agg1.TBL_AGG.FieldByName('AGG_NAME').AsString := 'Neue Gruppe';
Tab_AG.Hide;
fr_agg1.Align := alClient;
Tab_AGG.Show;
FTreeInsert := False;
end;

//Select a specific Node
Procedure TF_AG.SelectNode(Typ,ID : Integer);
var I : Integer;
Node : PVirtualNode;
AData : PItemInfo;
found : Boolean;
begin
Node := TreeView1.GetFirstNode;
found := False;
while (Node <> nil) and not(found) do
begin
Adata := TreeView1.GetNodeData(Node);
found := (AData.ID = ID) and
(AData.Typ = Typ);
if not Found then
Node := TreeView1.GetNext(Node);
end;
if Found then
begin
TreeView1.Selected[Node] := True;
TreeView1.FocusedNode := TreeView1.GetFirstNode;
If TreeView1.CanFocus then
TreeView1.SetFocus;
end;
end;

//If the Editing/Inserting is Canceled
procedure TF_AG.SB_CancelClick(Sender: TObject);
var
AData : PitemInfo;
begin
Case FAG_EditContext of
AGG : begin
Case FAG_EditState of
AG_Insert : Begin
Try
fr_agg1.tbl_AGG.Cancel;
TreeView1.DeleteNode(TreeView1.GetFirstSelected);
FAG_EditState := AG_Browse;
if not fr_agg1.tbl_AGG.Eof then
SelectNode(0,fr_agg1.tbl_AGG.FieldByName('AGG_ID').AsInteger);
except
Raise;
end;
end;
AG_Modify : Begin
Try
fr_agg1.tbl_AGG.Cancel;
FAG_EditState := AG_Browse;
AData := TreeView1.GetNodeData(TreeView1.GetFirstSelected);
AData.Name := fr_agg1.tbl_AGG.FieldByName('AGG_NAME').AsString;
except
Raise;
end;
end;
end;
end;
AG : begin
Case FAG_EditState of
AG_Insert : Begin
Try
fr_ag1.tbl_ag.Cancel;
TreeView1.DeleteNode(TreeView1.GetFirstSelected);
FAG_EditState := AG_Browse;
if not fr_agg1.tbl_AGG.Eof then
SelectNode(0,fr_agg1.tbl_AGG.FieldByName('AGG_ID').AsInteger);
except
Raise;
end;
end;
AG_Modify : Begin
Try
fr_ag1.tbl_AG.Cancel;
FAG_EditState := AG_Browse;
AData := TreeView1.GetNodeData(TreeView1.GetFirstSelected);
AData.Name := fr_ag1.tbl_AG.FieldByName('AG_NAME').AsString;
except
Raise;
end;
end;
end;
End;
AGPR : begin
try
fr_ag1.tbl_agpr.Cancel;
FAG_EditState := AG_Browse;
fr_ag1.AdJustButtons;
except
Raise;
end;
end;
end;
AdJustNav;
end;

//Modify Record
procedure TF_AG.SB_EditClick(Sender: TObject);
var AData : PItemInfo;
begin
Case FAG_EditContext of
AGG : begin
fr_agg1.Tbl_AGG.Edit;
fr_agg1.DBEdit1.SetFocus;
FAG_EditState := AG_Modify;
end;
AG : begin
fr_ag1.tbl_ag.Edit;
fr_ag1.DBEdit1.SetFocus;
fr_ag1.AdJustButtons;
FAG_EditState := AG_Modify;
end;
AGPR : begin
fr_ag1.tbl_agpr.Edit;
fr_ag1.DBEdit9.SetFocus;
fr_ag1.AdJustButtons;
FAG_EditState := AG_Modify;
end;
end;
AData := TreeView1.GetNodeData(TreeView1.GetFirstSelected);
if assigned(AData) then
Panel4.Caption := TreeType[AData.Typ]+' "'+
AData.Name+'"';
AdJustNav;
end;

//Delete a Record
procedure TF_AG.SB_DeleteClick(Sender: TObject);
var
AData : PItemInfo;
begin
AData := TreeView1.GetNodeData(TreeView1.GetFirstSelected);
if messagedlg('Mvchten Sie wirklich die '+#10+
TreeType[AData.Typ]+' "'+
AData.Name+'"'+#10+'lvschen?',
mtConfirmation, [mbYes, mbNo], 0) = mrYes then
begin
Case FAG_EditContext of
AGG : begin
Try
fr_agg1.Tbl_AGG.Delete;
TreeView1.DeleteNode(TreeView1.GetFirstSelected);
except
messagedlg(
TreeType[AData.Typ]+' "'+
AData.Name+'"'+#10+'kann nicht gelvscht werden!',
mtInformation, [mbOK], 0);
end;
end;
AG,AGPR : begin
Try
fr_ag1.tbl_ag.Delete;
TreeView1.DeleteNode(TreeView1.GetFirstSelected);
except
messagedlg(
TreeType[AData.Typ]+' "'+
AData.Name+'"'+#10+'kann nicht gelvscht werden!',
mtInformation, [mbOK], 0);
end;
end;
end;
AdJustNav;
end;
end;

//Insert Item
procedure TF_AG.SB_InsertClick(Sender: TObject);
var
ANode : PVirtualNode;
AData, PData, PPData : PItemInfo;
begin
PData := TreeView1.GetNodeData(TreeView1.GetfirstSelected);
PPData := TreeView1.GetNodeData(TreeView1.GetfirstSelected.Parent);
FTreeInsert := True;
tab_agg.Hide;
panel4.Caption := TreeType[1]+' "Neuer Arbeitsgang"';

if PData.Typ = 0 then
ANode := TreeView1.AddChild(TreeView1.GetFirstSelected)
else
ANode := TreeView1.AddChild(TreeView1.GetFirstSelected.Parent);
AData := TreeView1.GetNodeData(ANode);
AData.ID := 0;
AData.Typ := 1;
AData.PID := 0;
AData.Name := 'Neuer Arbeitsgang';
TreeView1.Selected[ANode] := True;
TreeView1.FocusedNode := TreeView1.GetFirstNode;
TreeView1.ScrollIntoView(ANode,True);

fr_ag1.tbl_ag.Insert;
fr_ag1.tbl_ag.FieldByName('AG_ID').AsInteger := -1;

if PData.Typ = 0 then
fr_ag1.tbl_AG.FieldByName('AG_AGG_ID').AsInteger := PData.ID
else
fr_ag1.tbl_AG.FieldByName('AG_AGG_ID').AsInteger := PPData.ID;

fr_ag1.tbl_ag.FieldByName('AG_NAME').AsString := 'Neuer Arbeitsgang';

FAG_EditState := AG_Insert;
FAG_EditContext := AG;
fr_ag1.align := alClient;
fr_ag1.panel1.align := alClient;
Tab_AG.Show;
FTreeInsert := False;
AdjustNav;
fr_ag1.DBedit1.SetFocus;
end;

//If the Item Caption is to Change
procedure TF_AG.fr_ag1DBEdit2Change(Sender: TObject);
var AData : PItemInfo;
begin
if (fr_ag1.Tbl_AG.State = dsEdit) or
(fr_ag1.Tbl_AG.State = dsInsert) then
begin
AData := TreeView1.GetNodeData(TreeView1.GetFirstSelected);
AData.Name := fr_ag1.DBEdit2.Text;
Panel4.Caption := TreeType[AData.Typ]+' "'+
AData.Name+'"';
TreeView1.Refresh;
end;
end;

<--------------------- Moving (Drag&Drop)

Type
TDragDropType = (tiTargetNone,tiTragetRootGroup,tiTargetGroup,tiTargetItem,tiSourceGroup,tiSourceItem,tiGroupSelf);
TDragDropTypeSet = set of TDragDropType;

//Evaluate the Drag-Drop-Pair
function TF_AG.SetTreeItemTypeSet(SourceNode : PVirtualNode;TargetNode : PVirtualNode) : TDragDropTypeSet;
var
SData, TData : PItemInfo;
begin
Result := [];
SData := TreeView1.GetNodeData(SourceNode);
TData := TreeView1.GetNodeData(TargetNode);
If Assigned(SData) then
case SData.Typ of
0 : Result := Result + [tiSourceGroup];
1 : Result := Result + [tiSourceItem];
end;
If Assigned(TData) then
Case TData.Typ of
0 : Result := Result + [tiTargetGroup];
1 : Result := Result + [tiTargetItem];
end;
If not Assigned(TData) then
Result := Result + [tiTargetNone]
else
If not Assigned(TargetNode.Parent) then
Result := Result + [tiTragetRootGroup];

if (tiSourceItem in Result) and (tiTargetItem in Result) then
if (SourceNode.Parent = TargetNode.Parent) then
Result := Result + [tiGroupSelf];

if (tiSourceItem in Result) and (tiTargetGroup in Result) then
if (SourceNode.Parent = TargetNode) then
Result := Result + [tiGroupSelf];

if (tiSourceGroup in Result) and (tiTargetNone in Result) then
if not assigned(SourceNode.Parent) then
Result := Result + [tiGroupSelf];

if (tiSourceGroup in Result) and (tiTargetGroup in Result) then
if (SourceNode = TargetNode) then
Result := Result + [tiGroupSelf];

if (tiSourceGroup in Result) and (tiTargetItem in Result) then
if (SourceNode = TargetNode.Parent) then
Result := Result + [tiGroupSelf];

end;

//Begin to Drag?
procedure TF_AG.TreeView1MouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
var ANode : PVirtualNode;
begin
ANode := TreeView1.GetFirstSelected;
if (FAG_EditState = AG_Browse) and
(ssLeft in Shift) and
(not FInDrag) and
(Assigned(ANode)) then
begin
TreeView1.BeginDrag(False,8);
FInDrag := True;
end;
end;

//End of Drag, No Op
procedure TF_AG.TreeView1MouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
FInDrag := False;
TreeView1.Refresh;
end;

//Check if allowed
procedure TF_AG.TreeView1DragOver(Sender: TBaseVirtualTree;
Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint;
Mode: TDropMode; var Effect: Integer; var Accept: Boolean);
var
TargetNode : PVirtualNode;
DragSet : TDragDropTypeSet;
begin
TargetNode := TreeView1.GetNodeAt(pt.x,pt.y);
DragSet := SetTreeItemTypeSet(Treeview1.GetFirstSelected,TargetNode);
Accept := Not(tiGroupSelf in DragSet) and
Not((tiSourceItem in DragSet) and (tiTargetNone in DragSet));
end;

//now dropping
procedure TF_AG.TreeView1DragDrop(Sender: TBaseVirtualTree;
Source: TObject; DataObject: IDataObject; const Formats: array of Word;
Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode);
var
TargetNode, TempNode : PVirtualNode;
DragSet : TDragDropTypeSet;
AData, SData, PData : PItemInfo;
begin
SData := TreeView1.GetNodeData(TreeView1.GetFirstSelected);
TargetNode := TreeView1.GetNodeAt(pt.x,pt.y);
If assigned(TargetNode) then
PData := TreeView1.GetNodeData(TargetNode.Parent)
else
PData := NIL;
DragSet := SetTreeItemTypeSet(Treeview1.GetFirstSelected,TargetNode);
//Check for Recursive Hirarchy
if (tiSourceGroup in DragSet) then
begin
TempNode := TargetNode;
//Recursive Check
repeat
AData := TreeView1.GetNodeData(TempNode);
IF assigned(AData) and (Adata.ID <> SData.ID) Then
TempNode := TempNode.Parent;
until (AData = NIL) or (Adata.ID = SData.ID) or (TempNode = NIL);
if (TempNode <> NIl) and (AData <> NIL) then
begin
ShowMessage('Rekursive Hirarchie ist nicht erlaubt!');
//TreeView1.Options := TreeView1.Options - [toAutoExpand,toAutoScroll];
FInDrag := False;
TreeView1.Refresh;
Exit;
end;
end;

AData := TreeView1.GetNodeData(TargetNode);
//Depending on the pair, the Updates differs
if (tiSourceGroup in DragSet) and (tiTargetNone in DragSet) then
begin
Q_AGG_SETPARENT.ParambyName('AGG_AGG_ID').Clear;
Q_AGG_SETPARENT.ParambyName('AGG_ID').AsInteger :=
SData.ID;
Q_AGG_SETPARENT.ExecSQL;
SData.PID := 0;
TreeView1.MoveTo(TreeView1.GetFirstSelected,TargetNode,amAddChildLast,False);
end else
if (tiSourceGroup in DragSet) and (tiTargetItem in DragSet) then
begin
If AData.PID = 0 then
Q_AGG_SETPARENT.ParambyName('AGG_AGG_ID').Clear
else
Q_AGG_SETPARENT.ParambyName('AGG_AGG_ID').AsInteger :=
AData.PID;
Q_AGG_SETPARENT.ParambyName('AGG_ID').AsInteger :=
SData.ID;
Q_AGG_SETPARENT.ExecSQL;
SData.PID := AData.PID;
TreeView1.MoveTo(TreeView1.GetFirstSelected,TargetNode.Parent,amAddChildLast,False);
end else
if (tiSourceGroup in DragSet) and (tiTargetGroup in DragSet) then
begin
Q_AGG_SETPARENT.ParambyName('AGG_AGG_ID').AsInteger :=
AData.ID;
Q_AGG_SETPARENT.ParambyName('AGG_ID').AsInteger :=
SData.ID;
Q_AGG_SETPARENT.ExecSQL;
SData.PID := AData.ID;
TreeView1.MoveTo(TreeView1.GetFirstSelected,TargetNode,amAddChildLast,False);
end else
if (tiSourceItem in DragSet) and (tiTargetGroup in DragSet) then
begin
Q_AG_SETPARENT.ParambyName('AGG_ID').AsInteger :=
AData.ID;
Q_AG_SETPARENT.ParambyName('AG_ID').AsInteger :=
SData.ID;
Q_AG_SETPARENT.ExecSQL;
TreeView1.MoveTo(TreeView1.GetFirstSelected,TargetNode,amAddChildLast,False);
end else
if (tiSourceItem in DragSet) and (tiTargetItem in DragSet) then
begin
Q_AG_SETPARENT.ParambyName('AGG_ID').AsInteger :=
PData.ID;
Q_AG_SETPARENT.ParambyName('AG_ID').AsInteger :=
SData.ID;
Q_AG_SETPARENT.ExecSQL;
TreeView1.MoveTo(TreeView1.GetFirstSelected,TargetNode.Parent,amAddChildLast,False);
end else
ShowMessage('Diese DragOption ist nicht vorgesehen');
FInDrag := False;
TreeView1.Refresh;
TreeView1.ScrollIntoView(TreeView1.GetFirstSelected,True);
TreeView1.FocusedNode := TreeView1.GetFirstSelected;
end;

<------------------------- miscalinous

//Assign Images
procedure TF_AG.TreeView1GetImageIndex(Sender: TBaseVirtualTree;
Node: PVirtualNode; Kind: TVTImageKind; Column: Integer;
var Index: Integer);
var AData : PItemInfo;
begin
AData := Sender.GetNodeData(Node);
Case AData.Typ of
0 : Case Kind of
ikNormal : Index := 0;
ikSelected : Index := 1;
end;
1 : Case Kind of
ikNormal : Index := 2;
ikSelected : Index := 3;
end;
end;
end;

//Provide Nodetext
procedure TF_AG.TreeView1GetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: Integer; TextType: TVSTTextType;
var Text: WideString);
Var AData : PItemInfo;
begin
AData := Sender.GetNodeData(Node);
Text := AData.Name;
end;

<--------------------------- End

Well this is really partial,
as i'm german some messages are in german language

hope this helps,
just ask if something unclear,
because i have it rarely commented

meikl ;-)

morgantop

ASKER

thanks for the help and code guys. i will evaluate your suggestions asap.

from first look at the first code, i dont quite see how the tree is loaded recursivly from the db.
the node order display should be handled via node_order.
and cat_id has no roll in the tree order creation.
for all i know cat_id could even be a GUID.
(ie: select * from cat order by parent_id,cat_id)

but i will check the code as soon as i get back to work.
if i dont deliver a demo by the end of the week, i'm out of job :(

kretzschmar,
as i asked _no_ BDE code please. i am a beginner with db in delphi and could not convert this code to work with ado.
i do not know what is the form stuctore of your project.
what is your table db structor?

what is the TDataModule good for in basic?

can you send me a working demo (with ado) so i can compile it, i will grant you 1000 pts (if you want even more)
the german translation i can do from a dictionary :)

my email is at:
morgantop70@yahoo.com

pls tell me if i'm not out of line here... i do not want to be rude. thanks a milion for the help!

morgantop

ASKER

btw, if you think that i need to change/restructur the db tree let me know.
but the task should be a tree of categories and each item/product can be placed in many categories.

for example:
cat_x
cat_x1 -> (item1, item2)
cat_x2
cat_y -> (item2)
cat_y1 -> (item3, item1)

etc...

sundayboys

?kretzschmar
u said my code very slow,just look nice?!

Procedure TForm1.Load_Tree;
var
ANode : TTreeNode;
RecordCache : PDataCacheRecord;
RecordCacheList : TList;
I, PreviousCount : Integer;
begin
TreeView1.Items.Clear;
ADOQuery1.Close;
ADOQuery1.SQL.Text := 'Select ID, ID_Parent, Description from Tree_Table Order by Id_Parent';
RecordCacheList := TList.Create;
try
ADOQuery1.Open;
//Cache Data
while not ADOQuery1.Eof do
begin
RecordCache := New(PDataCacheRecord);
RecordCache^.ID := ADOQuery1.FieldByName('ID').AsInteger;
RecordCache^.PID := ADOQuery1.FieldByName('ID_Parent').AsInteger;
RecordCache^.Text := ADOQuery1.FieldByName('Description').AsString;
RecordCacheList.Add(RecordCache);
ADOQuery1.Next;
end;
ADOQuery1.Close;
//Adding Roots
PreviousCount := RecordCacheList.Count;
i := 0;
While i < RecordCacheList.Count do
begin
If PDataCacheRecord(RecordCacheList.Items[i])^.PID = 0 then //RootEntry
begin
ANode := TreeView1.Items.AddChild(NIL,PDataCacheRecord(RecordCacheList.Items[i])^.Text);
ANode.Data := RecordCacheList.Items[i];
RecordCacheList.Delete(i);
end
else inc(i);
end;
//Adding Childs
//Loop until there is nothing or it is never reduced -> inkonsistence
While (RecordCacheList.Count > 0) and (PreviousCount <> RecordCacheList.Count) do
begin
i := 0;
PreviousCount := RecordCacheList.Count;
while i < RecordCacheList.Count do
begin
ANode := FindParent(TreeView1,PDataCacheRecord(RecordCacheList.Items[i])^.PID);
if Anode <> NIL then
begin
ANode := TreeView1.Items.AddChild(ANode,PDataCacheRecord(RecordCacheList.Items[i])^.Text);
ANode.Data := RecordCacheList.Items[i];
RecordCacheList.Delete(i);
end
else inc(i);
end;
end;
if RecordCacheList.Count > 0 then
raise exception.Create('Data-Inkonsistence Detected!');
finally
RecordCacheList.Free;
end;
end;

this is u code,i look it....
there have three circle(while,while,while),and use TList to save all pointers(Count=RecordCount),my code only one circle(for),and use array of TTreeNode to save all pointers(TTreeNode Type),(Count=RecordCount), as u say ,if the database very very larger, my program will run very slow,but u think u program run fast than me???

by the way: i want change my id->Apollo ;-)

kretzschmar

@apollo (in spe)
>u said my code very slow,just look nice?!
I never said, that your code runs slow,
i just said, that you may have problems,
if the IDs are not continiously
(caused by deleted entries)

> ChildNo := QueryDM.GetID;
> ParentNo := QueryDM.GetParentID;
> TempNode[ChildNo] := TreeView1.Items.AddChild(TempNode[ParentNo], QueryDM.GetCatName);

the ChildNo can be higher than your allocated
TTreeNode-Array(based on the count of records)
->access violation
similar problem is by the ParentNo,
or do i see this wrong?

well, why three whiles,
first while->load all records->minimize database-access-time
second while->add root nodes only->this can be shorten
third while->add childs

just to say, it doesn't matter much how to sort the query
(except for the root Nodes),
the child-entries are allways mixed, you can't assume, that the parent_id is allways smaller than the child_id

@morgantop

>of categories and each item/product
>can be placed in many categories.

then you have a n:n relation, that not good db-design,
to mormalize this, you need a third table

simplified structure

Table Cat
-----------
ID
Parent_ID
OtherFields

Table Items
--------------
ID
OtherFields

Table Cat-Item-Relation
------------------------
ID
Cat_ID
Item_ID
maybe OtherFields

by this kind of Relations,
no kind of loading matches this

>as i asked _no_ BDE code please

this doesn't matter, if you use a TQuery or a TADOQuery,
the methods are allways the same->simple to replace

>i dont quite see how the tree is
>loaded recursivly from the db

a recusion is not involved here,
because if you want to load recursive,
you have to create on each level a dynamic query-object
->needs much more resources
->slows down the performance

i will prepare a sample and send it to you,
if you confirm the structure above

@all
some benchmarks:
i handle about 20000 Nodes
(fetching records->~5 Secs, that is fix)

using Standard TTreeView-> ~4 Minutes
using Lischke's TTreeNT-> ~1,5 Minutes
using Lischke's VitualTree -> ~20 Seconds

meikl ;-)

sundayboys

hehe,kretzschmar , u are right,there have a bug when the cat_id not continuum. so i suggestion: not load all node at once,just load root node first,if user click the node (or dragover) then load the child node if have.
if must load all node at once ,only change my code:
Count := get max(cat_id) from cat.
do this,will waste the mem :-(

Apollo;-)

morgantop

ASKER

kretzschmar, if you will see my first post you will see that my db stucture is the same ie:
CAT
ITEMS
ITEMS_CAT_REF

your "Table Cat" is missing one important field (in my opinion):
node_order (or cat_order / priority)

if i want to move or swap nodes or change the location u need some kind of order field. i do not want to base the order on the cat_id (ID). meaning cat_id can be represented by a random number.

please look my first post on how i think node order should be handled (via node_order).

also very important to me is to be able to save the tree buck to db.

but maybe i'm missing something :-P
thanks.

kretzschmar

>if i want to move or swap nodes or change
>the location u need some kind of order field.

in this case you need a custom-sort_routine
of the treeview-items

>also very important to me is
>to be able to save the tree buck to db.

currently i use the tree only for navigating,
the insert/modify/delete is done in another dataset,
based partial on tree-operations (move/swapping nodes),
this changes are done on realtime
(you do it, and it is saved->no tree buck saving needed)

well, ok, coding a sample,
this may take some time

meikl ;-)

smurff

>using Lischke's VitualTree -> ~20 Seconds

No Way!!! Nice work, is it easy to use?
Sorry to butt in on the question :)

morgantop

ASKER

some thing tells me this task would not be simple...
in all samples i saw (IBO_VT and DB VT) they sort the records by PARENTFIELD, KEYFIELD.
which is a big problem for me.
in both examples i cannot change the node location (in same node level)

for example if i have:
root_1 (id 78987) - node_order=1
...
root_2 (id 40989) - node_order=2
...

and i want to change the display to:
root_2 (id 40989) - node_order=1
...
root_1 (id 78987) - node_order=2
...

i need some field to represent the node order/priority.

maybe this can be done by JOIN the CAT table on itself where cat_id=parent_id order by node_order

(just a thoght)

kretzschmar

@morgantop

>and i want to change the display to:
as it is only for display, it doesn't matter,
how it is sorted in the database

->just let the treeview sort the nodes as you wish
->custom-sort-routine

my 30 days delphi 7 trial is out :-(
so i can only do something at home this evening
(anyone knows how to refresh 30 days again?)

@smurff

>is it easy to use?
its a bit different to use as the standard-treeview,
but similar easy or hard (depends on yours)

meikl ;-)

morgantop

ASKER

kretzschmar,
"as it is only for display, it doesn't matter, how it is sorted in the database" ?

after you save treeview to db how do you load it again with the modified tree/node order back? :-P

anyway, i'm trying to find a d7 pacth for you ;)
btw, i have d5/6

kretzschmar

>after you save treeview to db
i do not save the tree,
any changes are at the moment
as they appears saved->
see Moving (Drag&Drop) above

>btw, i have d5/6
well, at home i have d5 also,
but as the 30 days now are gone for the d7 installation
here, i can only do coding at home, now, so i do
loose time for your problem

>i'm trying to find a d7 pacth for you ;)
don't know if there is one possible

meikl ;-)

gallaghe

Check out ABC components, they have a data driven Treeview which does all the work for you.

http://www.obsof.com/

morgantop

ASKER

i have tried the "loadtree_u" at work and got an error when the ADOQuery1.Close executes (something about bof and eof)
if i removed this line i got the same error when i exit the program.
no luck yet.

kretzschmar

i advice you to install the ADOExpress Update Patch
see
http://bdn.borland.com/article/0,1410,26606,00.html

download at
http://info.borland.com/devsupport/delphi/mdac26.html

maybe some other updates are missed
see
http://info.borland.com/devsupport/delphi/downloads/index.html

meikl ;-)

morgantop

ASKER

kretzschmar, thanks. i will install the patches.
any luck with the project yet?

kretzschmar

>any luck with the project yet?

:-))
thats not a question of luck,
its more a question of time
(i've a family with three kids,
so evening time is too short)

more luck/time i've this weekend

hope thats fast enough

meikl ;-)

morgantop

ASKER

this q now worth 1000 pts. i will open a nother thread with 500 for a full solution (read+move+add+delete+save).

I have tried the DB aware VirtualDBTreeEx (wich is part of VirtualTreeView ext), but there is no demo of usage and it does not work quit like i excpet it.
the main problem is with the ID, parentID structure.
i cannot change the order of nodes in the same level,
and SAVE the order of nodes in the DB for futer use.

kretzschmar

give me time until sunday

morgantop

ASKER

let me be more specific about tree/node ordeing:
if i have this categories:

-Games
- Card Games
- Word Games
-Music
- Electronic
- R&B
- Ambiant

i want to be able to move nodes and get this:

-Music
- R&B
- Ambiant
- Electronic
-Games
- Word Games
- Card Games

note that categories are swaped (in each level)
i need to *store* the ordering (it is NOT sorting) in the DB
becouse i have a nother application/script that need to "know" this ordering and rebuild the same tree from the same DB/table.

morgantop

ASKER

kretzschmar, any "luck"? :)

kretzschmar

in process,
will be ready in a few hours :-)

btw. will this be a multiuser-app?

morgantop

ASKER

kretzschmar, yer da man :)
no, it's not multiuser. is there any issue with that?

very important: will i be able to handle the sibling order of nodes?

btw, i was going over your code,
in Function TF_AG.FindParent...
there is a call to: Node := Tree.GetFirstNode;
i'm using Virtual tree version 3.5.1
there is no method "GetFirstNode" but there is "GetFirst".
did u subcluss TVirtualStringTree, or maybe i'm using older/newer version?

getting exicted here... ;)

kretzschmar

ooops,
i use version 1.31,
seems i have to update :-)

kretzschmar

sorry, time was too short,
just not ready yet,
but working on it this evening gagain

meikl ;-)

morgantop

ASKER

i'm breaking my head with VirtualTreeView here and loading the the info in a single loop... :(
in all example of VT they first alocate RootCount then assign values to the data. go figure.
kretzschmar, in both your examples you load all data,
first loop on root nodes, then loop and build on child nodes.
is there an "invisible" reason why not load the tree in a single loop?
btw, any progess or you dumped me? ;)

kretzschmar

>is there an "invisible" reason why not
>load the tree in a single loop?

no, for me its just a perfomance issue,
because on later iteration for the childs,
the root is there, and this is only ID
where i can sort for in the db,
because the parent_ids of the childs
can be very mixed

just keep in mind, that fetching from
the db is faster than sorting into the tree

well, i'm not ready yet

morgantop

ASKER

anybody?...

kretzschmar

as last week,
during week too less time,
this weekend hopefully completion

btw. it may a bit much source,
for posting here
can you provide your email?

meikl ;-)

morgantop

ASKER

my email is at:
morgantop70@yahoo.com

could you please send me to see the not complete code, so i can learn in the mean while your code.
thanks

morgantop

ASKER

inc points to 1500

xywjb

morgantop,have you received some new answer? can you email me? my email addr. wj2zd@263.net

morgantop

ASKER

no answer yet.
in kretzschmar we trust ;)

kretzschmar

as far as i have coded,
i have sent you both now

meikl ;-)

morgantop

ASKER

kretzschmar, i had a few time to review what you send.
first all, yer the king ;)
you realized *exactlly* what i needed!

when i run the exe at work (mdac 2.6 + ado patch with D5) i got an error:
"Either EOF or BOF is True, or the current record..."
I recompiled and it worked fine. at home there where no problems running exe (mdac 2.5). i will check into it once i get to diploiment stage, i dont care about this now.

your program (or at list the consept/target program) will do what i wanted! too bad i cant have you as a partner at work ;)
it gave me a good idea and instructions.

all works fine, execpt when i try to add a sub category (ie: "Insert Cat -" ) i got an access violation error.
from quick look at the code (InsertCatSubLevel) i have noticed that you forgot to assign the ANode to the selected/active node:
...
If assigned(ANode) then
begin
NodeRec := vsTree.GetNodeData(ANode);
...
so this should be the error. i should check this.

--------------------------------------------------------
one thing that was a bit not unusuall to me is the use of "pointer of pointer" PPNodeRec. it got me a bit confused (thow i understand the structur) cuz in all examples from virtual tree i saw no use or reason to use a poiner of pointer type to point the data, ie PNodeRec (one pointer) was enoght to store and access the node data.
also in your original demo u used "Type PItemInfo = ^TItemInfo;"
i will be glad to hear what was your considurations with this structur.

also, the Items in the tree are not needed for me (i will display them in listview), but it gave me a good idea on how to do this if i needed it! bravo.

looking forward to get the completed version with priority (exactlly what i need!) and draging stuff...

i will give you 500 pts in this thread, cuz you rull.
and use the other 2 threards i opened to give 500 each, when u complete it.
https://www.experts-exchange.com/questions/20416393/1000-pts-ado-treeview.html
https://www.experts-exchange.com/questions/20410950/1000-pts-ado-treeview.html

hope it's cool with you.

please continue to post in this thread.
hope this important issue will help others as well.

cheers.

kretzschmar

too much honours :-))

as feedback i didn't thought about a grading (but thanks ;-),
i just only wanted to know, if i am on the right track
(well i failed the track a bit

>also, the Items in the tree are not needed for me

in this case the item logic is not needed,
but i will implement the missing features also with the item-logic.
for an adjustment to your needs, there are only two minor changes to do
- delete the loaditems-call in the refreshtree-method
- add a listview populate method in the onChange event of the tree
(well, the item logic oberhead will then be)
)

>when i run the exe at work (mdac 2.6 + ado patch with D5)
>i got an error: "Either EOF or BOF is True, or the
>current record..."

seems i have missed an update again

>execpt when i try to add a sub category
>(ie: "Insert Cat -" ) i got an access violation error.

:-( forgot to test it, here in germany we would say
"Das Programm wurde mit der heissen Nadel gestrickt",
that means "the program is coded in hurry" :-)
thats why its not correct tested in all cases,
but this error will be fixed in the final version

>one thing that was a bit not unusuall
>to me is the use of "pointer of pointer" PPNodeRec

the reason is, how the vsTree is storing the data,
if i use a pointer of record, then the record itself is stored in the nodes data (simple explaination),
but as i have on item-side the feature that an item
can be attached on multiple Cat-Nodes, i don't want the
Record in the Node-DataArea (because of redundand data),
so i only want to store a reference-pointer there, which
points to the record, which is located somewhere.

sample
[] <- means, this is stored in the Node-Data
pointer of [record]
pointer of [pointer] of record

>too bad i cant have you as a partner at work ;)

currently, i earn my money for living costs of me and my
family not with programming with delphi ;-)

>looking forward to get the completed version with
>priority (exactlly what i need!) and draging stuff...
yep, began yesterday,
i will implement
- move (including childs)
- copy(with Ctrl-Key pressed on drop, including childs)
- sort(with shift-key pressed on drop, Cat only)

about points, well thats ok for me, but not needed,
because its a nice project for me :-))

for all other listeners,
i will post the final source in this thread
(will be about 1000 lines of code,
hope i can post it at one piece)

>please continue to post in this thread.
i will do asap, just sorry about my small time window

btw.
morgantop, our timezones seems to be opposite,
where come you from?

meikl ;-)

morgantop

ASKER

> too much honours
not for a person who do this from all his heart and helps me and other programmers at his own time!
i very appritiate it.

the issue with the "pointer of pointer" type is now clear to me. very good idea indeed. your code also takes care of freeing the memory correctly so i'm very pleased it's also safe (i was very conserned with *my* original code about memory leeks).

>where come you from?
i came from russia, currntly staying in israel with wife and child with plans to move to canada with in 2 moths from now.

looking forward to the grand finale ;)
cheers.

morgantop

ASKER

kretzschmar, how are u? any updates? ;)

kretzschmar

hi,

i'm fine, thanks,
final version is still in progress,
will be ready tomorrow evening, maybe today
(changing the drop-logic just now,
to get it more readable)

be patient

meikl ;-)

kretzschmar

update sent->not ready yet->copy missed

morgantop

ASKER

kretzschmar, you did a hell of a job!
it seems to works ok, there are a few bugs (wich i guess u have not tested yet)
when deleting node i get error:
"Record Not Found!
Please Reload Tree"
sometimes when i "insert cat-" the drag wont work after that.
sometimes when i "insert cat |" nothing happens.

just a thoght: a bit "strange" how you implimented the ordering of nodes (drag with shift key)
thoght it would be much better with toShowDropMark (but this is just my thoght)

this could finally be a GREATE stand alone component. it is much better than TDBVirtualTree as far as i can tell...

i will look into it tommorow with a deeper qa-ing and learing the code ;)

ps: please post what-ever comment here:
https://www.experts-exchange.com/questions/20416393/1000-pts-ado-treeview.html
so i can grant u more 500pts ;)
thanks

kretzschmar

:-)) glad you like it

yep, i have not tested it as whole,
only part function tests i have done,
so that some bugs are sill there

>just a thoght: a bit "strange" how you implimented the
>ordering of nodes (drag with shift key)
>thoght it would be much better with toShowDropMark (but
>this is just my thoght)

i noticed that there are some new features
in the ver 3.5.1, even so the toShowDropMark,
but i got not the time to evaluate how to use it,
so i disabled this feature temporary, but if i am
ready with the copy part, i will try to change
the move-part, to use this feature,
it just looks better for the user,
and the shift-key is then never used for moving

well, next weekend comes the final version,
hopefully better tested and bugfree then

meikl ;-)

morgantop

ASKER

when i open the tree i get:
+Cat 0_2
+Cat 0_1

when i try to swap the order Cat 0_1, Cat 0_2 the DB wont get updated (draging Cat 0_1 with shift to Cat 0_2)
i see the changes in the display tree, but when i load app again the order stays the same.

kretzschmar

hmm,
seems to be a bug with root-nodes,
please inform me, if you find more bugs

primary, i have a plan, how to change the sort
by using the toShowDropMark

meikl ;-)

kretzschmar

xywjb, any thoughts?

morgantop

ASKER

basically, there are a few bugs as i metioned in the post above:
>>when deleting node i get error:
>>"Record Not Found!Please Reload Tree"
>>sometimes when i "insert cat-" the drag wont work after >>that.
>>sometimes when i "insert cat |" nothing happens.

the instert part could be buggy becouze it seems that:
NodeRec := vsTree.GetNodeData(ANode);
in the "InsertCatSubLevel" is not assined sometimes even when it has focus, so nothing happens.

also maybe the:
"If FNodeEditMode = nemBrowse..." in the btnInsertCatSubLevelClick returns always false in some situations (after moving and "playing" around with nodes). could not figure it why.

also after deleting node, the order of nodes in the DB is not correct some times.

for me i dont care "copy" feture at all, nither all item manipulations (i disable this).
what's important is the load, move, and order.
also very important is that there will be no bugs ;)

perhaps this is becouse of buggy nature of TVirtualTree, dunno... for example: open the program, press "load" and see the gray focus looks strange. same happens when i insret new noeds and rename the node caption. but i can live with that.

from UI point of view, i think it would have been much easyer for you to ask for the category name (when click inserting) in a modal dialog, only then insert it as child or at same level, but maybe i'm wrong.

i will do more testing now.
i would also be glad to hear from xywjb (who did not even bother aword you points in his thread...)

kretzschmar

well,
then i move the copy part to end,
and fix the bugs first

>from UI point of view...
yep, would be a better choice to provide for edits a edit form, usual i used the tree on left side of appwindow
for navigation and the left side as editpanel

meikl ;-)

morgantop

ASKER

kretzschmar,
I was playing around with your code. created a new application and adding your modules/procedures one by one.

I've tryed to run this code (all ado properties same as your code also cursortype etc):

tblCat.Append;
tblCat.FieldByName('PID').AsInteger := 1; // just for test
tblCat.FieldByName('Name').AsString := 'new cat';
tblCat.Post;
ShowMessage(InttoStr(tblCat.FieldByNam('ID').AsInteger));

i always get 0 in the ID field insted of getting the "last_inserted" autonumber ID.

when i run this code on your mdb file it works ok.
i have an Access97 mdb (clone of yours). is that the problem/issue here, or did i miss something???
i was breaking my head with it for a hours... :(

morgantop

ASKER

any comments?

kretzschmar

hi morgantop,

well, i have no access 97,
but try to use the 3.5 ole-jet-db-driver
instead of the 4.0

you can also try

tblCat.Post;
tblCat.ReQuery;
ShowMessage(InttoStr(tblCat.FieldByNam('ID').AsInteger));

additional, i'm still not ready yet->
christmas preparations steels my time

i try to be ready this evening

meikl ;-)

morgantop

ASKER

kretzschmar, any progress?

kretzschmar

hi morgantop,
terrible sorry for delay,
but one child of mine had an accident
(falls down the stairs and had broken one arm),
just short after my last post,
and then i was in vacation, so the work
was standing still in the meantime

now i do continue

sorry again

meikl ;-)

smurff

meikl

I think I can speak for many people when I say we all understand that this forum is great but people do have other lives. e.g. Jobs, Family hobbies etc

Ive actually forgot what free time means :)

We all look forward to your code and I too have learnt from this post. Im not the person that asked this question but I believe you have been very helpfull and deserve the points.

btw Merry Xmas all
Regards
Smurff

morgantop

ASKER

Hi kretzschmar ,
first all and most important, best wishing for your son. i also have a son and he means the whole world to me.
hope all is well with him.

> sorry again
dont be. after the effort you done for me and the listeners. yer da man ;)

actually, i already implimented the tree in a slite differnt approch, and got usefull ideas from your code and understand how VT and ADO works.

philosoficaly speaking your post here gave me a bit of "confidens" as i was away from delphi more than 2 years.
and for that i'm greatfull.

i will be more than happy to get the finall code version, but no rush with that.
whether you deside to continue or not, all points are yours:
https://www.experts-exchange.com/questions/20410950/1000-pts-ado-treeview.html

now my main problem/dilema is with the implimentation of the Items per category "grid". i started out by implimenting it with a nother VirtualTreeView, but soon find out that this approch look *greate* from UI point of view, but very hard to program as i need to store all data info also in the VT (show other fields than Name), rather than use a standard DB binded DBGrid (sorting, draging, icons, etc are easy with VT).

tryed to impliment it by using db Locate on every call to GetText of VT, but realized that this is expensive method.
had to write a whole new class to "impersonate" VT as TDBGrid. but now i think i dump this idea...

i just hate how the DBGrid looks! VT is greate, and looks pro but its not a DateBase Grid :-P
i'm realy not 100% sure about this... but i think DBGrid solution is better.

Any insites on this issue btw?

i was looking for other cool DBGrids on the market, but none of them supports RTL correctly and cost a lot. and i'm very short with $$$.
also i could not sort all columns on DBGrid like with VT.

Maybe you can help me here:
https://www.experts-exchange.com/questions/20445792/customizing-DBgrid-Columns.html

cheers.

morgantop

ASKER

kretzschmar ,
please post a comment here:
https://www.experts-exchange.com/questions/20410950/1000-pts-ado-treeview.html
so i can award you points and paq this question.
tahnks.

kretzschmar

hi morgantop,

just got no time to make a final release
(stress with family and work, primary with the work,
because i'm about to change my employer).
hope you are not worry about this.

well, i think about to make a descanded vttree
with db-capability (one table/query based),
but this takes more time,
which i don't have yet.

looking forward to get more time.

i you want a great dbgrid, then take a look
to the quantumgrid from developers express
www.devexpress.com
but its also very expensive

i want to make it ready,
but this may take some additional weeks.
(contact me, if your are moved to your new location)

i will try to post the source
(latest you got by mail) as next comment.

see you

meikl ;-)

kretzschmar

well the source,
with some minor bugs,
which has morgantop described above,

maybe someone may pick it up,
and fixes the bugs earlier than i

unit vtTree_DB_n2n_u;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Db, ADODB, StdCtrls, ExtCtrls, VirtualTrees, ImgList, ActiveX;

type
TNodeType = (nCat //CatNode
,nItem //ItemNode
);

TNodeEditMode = (nemBrowse,nemInsert,nemModify);

TDragDropType = (ddtTargetNone //DropTarget = Nil
,ddtTargetCat //DropTarget = Cat
,ddtTargetItem //DropTarget = Item
,ddtSourceCat //DropSource = Cat
,ddtSourceItem //DropSource = Item
,ddtSourceOnParent //DropTarget is the Parent of DropSource
,ddtSourceOnSelf //Source = Target
,ddtSameParent //DropTarget Parent = DropSource Parent
,ddtCatRecursion //DropSource Level is Lower as DropTarget,
//whereas DropTarget is in the same branch
//and DropSource and DropTarget are both Cat-Nodes
,ddtItemRefExists //DropSource = Item, in the TargetBranch a Ref-Item is still there
//DropModes
,ddtCopy //Copy Action
,ddtMove //Move Action
,ddtSort //Sort Action
);

TDragDropTypes = set of TDragDropType;

TForm1 = class(TForm)
ADOConnection: TADOConnection;
qryLoadCat: TADOQuery;
tblCat: TADOTable;
tblItem: TADOTable;
tblCatID: TAutoIncField;
tblCatPID: TIntegerField;
tblCatName: TWideStringField;
tblCatPrio: TIntegerField;
tblItemID: TAutoIncField;
tblItemName: TWideStringField;
qryLoadItem: TADOQuery;
Panel1: TPanel;
btnLoad: TButton;
btnInsertCatSameLevel: TButton;
btnInsertCatSubLevel: TButton;
btnInsertItemTree: TButton;
vsTree: TVirtualStringTree;
qryCreateCatItemRel: TADOQuery;
ImageList1: TImageList;
btnDelete: TButton;
qryDeleteCatItemRel: TADOQuery;
Panel2: TPanel;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
CheckBox4: TCheckBox;
CheckBox5: TCheckBox;
CheckBox6: TCheckBox;
CheckBox7: TCheckBox;
CheckBox8: TCheckBox;
CheckBox9: TCheckBox;
CheckBox10: TCheckBox;
CheckBox11: TCheckBox;
CheckBox12: TCheckBox;
CheckBox13: TCheckBox;
qryUpdateCatItemRel: TADOQuery;
procedure FormCreate(Sender: TObject);
procedure btnLoadClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure vsTreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType;
var CellText: WideString);
procedure vsTreeFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure vsTreeChange(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure vsTreeGetImageIndex(Sender: TBaseVirtualTree;
Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
var Ghosted: Boolean; var ImageIndex: Integer);
procedure btnInsertCatSameLevelClick(Sender: TObject);
procedure btnInsertCatSubLevelClick(Sender: TObject);
procedure btnInsertItemTreeClick(Sender: TObject);
procedure vsTreeNewText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; NewText: WideString);
procedure vsTreeEditing(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; var Allowed: Boolean);
procedure vsTreeEditCancelled(Sender: TBaseVirtualTree;
Column: TColumnIndex);
procedure btnDeleteClick(Sender: TObject);
procedure vsTreeMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure vsTreeMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure vsTreeDragOver(Sender: TBaseVirtualTree; Source: TObject;
Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode;
var Effect: Integer; var Accept: Boolean);
procedure vsTreeDragDrop(Sender: TBaseVirtualTree; Source: TObject;
DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState;
Pt: TPoint; var Effect: Integer; Mode: TDropMode);
procedure vsTreeCompareNodes(Sender: TBaseVirtualTree; Node1,
Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
private
FTreeInsert : Boolean; //Determines, if the Tree is currently about to load
FNodeEditMode: TNodeEditMode; //Determines, if a Node is about to inserted, modified or nothing
FInDrag : Boolean; //Currently Dragging?
Procedure LoadCatToTree; //Load the Cat to the Tree
Procedure LoadItemToTree; //Load the Items to the Tree
procedure RefreshTree; //Load the tree from DB (Cat and Items)
Function FindParent( //Searches for a Parent Node
Tree : TVirtualStringTree; //Tree, where to Search
ID : Integer; //ID of the searched node
TYP : TNodeType //Type of the Searched Node
) : PVirtualNode;
Procedure CreateCatItemReference(Cat_ID,Item_ID : Integer); //Creates a Cat-Item Relation on DB
Procedure InsertCat(ANode : PVirtualNode); //Inserts a Cat-Entry into DB
Procedure InsertItem(ANode : PVirtualNode); //Inserts a Item-Entry into DB
Procedure ModifyCat(ANode : PVirtualNode); //Updates a Cat-Entry to DB
Procedure ModifyItem(ANode : PVirtualNode); //Updates a Item-Entry into DB
Procedure SyncModify(ANode : PVirtualNode); //Sync Inserts/Updates between Tree and DB
Procedure ReLocateRecord(ANodeType : TNodeType; ID : Integer); //Locates a Record in the DB
Procedure InsertCatSameLevel; //Insert A Cat-Entry on the Same Level as Selected Node
Procedure InsertCatSubLevel; //Insert A Cat-Entry as Child of Selected Node
Procedure InsertItemTree; //Inserts an Item into the Tree
Procedure DeleteCatItemRelation(CAT_ID, ITEM_ID : Integer); //Deletes a Cat-Item Relation
Procedure UpdateCatItemRelation(CAT_ID, CAT_ID_OLD, ITEM_ID : Integer); //Move an Item to a other Cat on DB
procedure DeleteItem(ANode : PVirtualNode); //Deletes an Item-Entry or Cat-Item-Releation
procedure DeleteCat(ANode : PVirtualNode); //Deletes a Cat-Entry
procedure DeleteObject; //Delete a Cat or Item;
function SetTreeItemTypeSet(SourceNode : PVirtualNode; //Determine what Kind of maybe Drop are
TargetNode : PVirtualNode) : TDragDropTypes;

Procedure ReSortCat(ParentNode : PVirtualNode);
Procedure doCopyCat(TargetNode, SourceNode : PVirtualNode);
Procedure doMoveCat(TargetNode, SourceNode : PVirtualNode);
Procedure doSortCat(TargetNode, SourceNode : PVirtualNode);
Procedure doCopyItem(TargetNode, SourceNode : PVirtualNode);
Procedure doMoveItem(TargetNode, SourceNode : PVirtualNode);

public
{ Public declarations }
end;

PPNodeRec = ^PNodeRec; //Pointer of Pointer of Record
PNodeRec = ^TNodeRec; //Pointer of Record
TNodeRec = Record
NodeType : TNodeType;
ID : Integer;
PID : Integer;
Name : String;
Priority : Integer; //Used by Cat only
RefCount : Integer; //Used by Items Only
end;

const
TNodeTitle : Array[TNodeType] of String = ('Catalog','Item');
//Valid Drop Actions
daCopyDropCatRoot : TDragDropTypes = [ddtTargetNone,ddtSourceCat,ddtCopy];
daMoveDropCatRoot : TDragDropTypes = [ddtTargetNone,ddtSourceCat,ddtMove];
daCopyDropCatOnCat : TDragDropTypes = [ddtTargetCat,ddtSourceCat,ddtCopy];
daMoveDropCatOnCat : TDragDropTypes = [ddtTargetCat,ddtSourceCat,ddtMove];
daCopyDropCatOnCatWithSameParent : TDragDropTypes = [ddtTargetCat,ddtSourceCat,ddtSameParent,ddtCopy];
daMoveDropCatOnCatWithSameParent : TDragDropTypes = [ddtTargetCat,ddtSourceCat,ddtSameParent,ddtMove];
daSortDropCatOnCat : TDragDropTypes = [ddtTargetCat,ddtSourceCat,ddtSameParent,ddtSort];
daCopyDropItemOnItem : TDragDropTypes = [ddtTargetItem,ddtSourceItem,ddtCopy];
daMoveDropItemOnItem : TDragDropTypes = [ddtTargetItem,ddtSourceItem,ddtMove];
daCopyDropItemOnCat : TDragDropTypes = [ddtTargetCat,ddtSourceItem,ddtCopy];
daMoveDropItemOnCat : TDragDropTypes = [ddtTargetCat,ddtSourceItem,ddtMove];
daCopyDropItemOnCatWithSameParent : TDragDropTypes = [ddtTargetCat,ddtSourceItem,ddtSameParent,ddtCopy];
daMoveDropItemOnCatWithSameParent : TDragDropTypes = [ddtTargetCat,ddtSourceItem,ddtSameParent,ddtMove];

var
Form1: TForm1;

implementation

{$R *.DFM}

const
connectionstr = 'Provider=Microsoft.Jet.OLEDB.4.0;'+
'User ID=Admin;'+
'Data Source="%s";'+
'Mode=Share Deny None;'+
'Extended Properties="";'+
'Jet OLEDB:System database="";'+
'Jet OLEDB:Registry Path="";'+
'Jet OLEDB:Database Password="";'+
'Jet OLEDB:Engine Type=5;'+
'Jet OLEDB:Database Locking Mode=1;'+
'Jet OLEDB:Global Partial Bulk Ops=2;'+
'Jet OLEDB:Global Bulk Transactions=1;'+
'Jet OLEDB:New Database Password="";'+
'Jet OLEDB:Create System Database=False;'+
'Jet OLEDB:Encrypt Database=False;'+
'Jet OLEDB:Don''t Copy Locale on Compact=False;'+
'Jet OLEDB:Compact Without Replica Repair=False;'+
'Jet OLEDB:SFP=False';
DBName = 'vtTree_DB_n2n.mdb';

procedure TForm1.FormCreate(Sender: TObject);
var
s, cs : string;
begin
s := ExtractFilePath(Application.ExeName)+DBName;
cs := Format(ConnectionStr, [s]);
ADOConnection.ConnectionString := cs;
try
ADOConnection.Connected := True;
tblCat.Open;
tblItem.Open;
except
raise Exception.Create('Error Opening database');
end;
vsTree.NodeDataSize := SizeOf(PPNodeRec); //DataSize is Size of Pointer
vsTree.SortTree(-1,sdAscending);
RefreshTree;
end;

Function TForm1.FindParent(Tree : TVirtualStringTree; ID : Integer; TYP : TNodeType) : PVirtualNode;
var Node : PVirtualNode;
NodeRec : PPNodeRec;
found : Boolean;

begin
Result := Nil;
Node := Tree.GetFirst;
found := False;
while (Node <> nil) and not(found) do
begin
NodeRec := Tree.GetNodeData(Node);
found := (NodeRec^.ID = ID) and
(NodeRec^.NodeType = Typ);
if not Found then
Node := Tree.GetNext(Node);
end;
If found then
result := Node;
end;

Procedure TForm1.LoadCatToTree;
var
ANode : PVirtualNode;
List : TList;
I : Integer;
SCount : Integer;
NodeRec : PNodeRec;
P : PPNodeRec;
begin
List := TList.Create;
Try
//Caching Information
//qryLoadCat holds: Select ID, PID, Name, Prio From Cat order by PID, PRIO
try
qryLoadCat.Open;
except
raise;
end;
While Not qryLoadCat.EOF do //read until end
Begin
New(NodeRec); //create Node-Record
NodeRec^.NodeType := nCat; //Fill Record
NodeRec^.ID := qryLoadCat.FieldByName('ID').AsInteger;
NodeRec^.PID := qryLoadCat.FieldByName('PID').AsInteger;
NodeRec^.Name := qryLoadCat.FieldByName('NAME').AsString;
NodeRec^.Priority := qryLoadCat.FieldByName('PRIO').AsInteger;
NodeRec^.RefCount := 0;
List.Add(NodeRec); //Store Temporary
qryLoadCat.Next; //Next Record
End;
qryLoadCat.Close;
//Add Roots First
I := 0;
While (List.Count > 0) and (PNodeRec(List[0])^.PID = 0) do //if Root
Begin
ANode := vsTree.AddChild(NIL); //New Node as Root
P := vsTree.GetNodeData(ANode); //Get Node's DataArea
P^ := List[0]; //store pointer to record
List.Delete(i); //Delete from List
end;
//Add Rest of Group
While List.Count > 0 do
Begin
SCount := List.Count;
I := 0;
While I < List.Count do
Begin
ANode := FindParent(vsTree,PNodeRec(List[i])^.PID,nCat);
If ANode <> Nil then
Begin
ANode := vsTree.AddChild(ANode); //New Node as Child
P := vsTree.GetNodeData(ANode); //Get Node's DataArea
P^ := List[i]; //store pointer to record
List.Delete(i); //Delete from List
end
else inc(i);
end;
//? DataInconstence
If List.Count = SCount then
Raise Exception.Create('Data-Inconsintence!!');
end;
finally
List.Free;
end;
end;

Procedure TForm1.LoadItemToTree;
var
ANode : PVirtualNode;
Old_ID : Integer;
NodeRec : PNodeRec;
P : PPNodeRec;
begin
//Load Items
qryLoadItem.Open;
//qryLoadItem SQL :
//Select i.ID, i.Name, cir.CAT_ID from Items i, cat_item_rel cir where i.ID = cir.ITEM_ID
try
Old_ID := -1;
While Not qryLoadItem.Eof do
begin
ANode := FindParent(vsTree,qryLoadItem .FieldByName('CAT_ID').AsInteger,nCat);
if assigned(ANode) then
begin
If Old_ID <> qryLoadItem.FieldByName('ID').AsInteger then
begin
New(NodeRec); //create Node-Record
NodeRec^.NodeType := nItem; //Fill Record
NodeRec^.ID := qryLoadItem.FieldByName('ID').AsInteger;
NodeRec^.PID := qryLoadItem.FieldByName('CAT_ID').AsInteger;
NodeRec^.Name := qryLoadItem.FieldByName('NAME').AsString;
NodeRec^.RefCount := 1;
Old_ID := qryLoadItem.FieldByName('ID').AsInteger;
end
else inc(NodeRec^.RefCount);
ANode := vsTree.AddChild(ANode); //New Node as Child
P := vsTree.GetNodeData(ANode); //Get Node's DataArea
P^ := NodeRec; //store pointer to record
end
else
Raise Exception.Create('Data-Inconsintence!!');
qryLoadItem.Next;
end;
finally
qryLoadItem.Close;
end;
end;

procedure TForm1.RefreshTree;
begin
vsTree.BeginUpdate;
FTreeInsert := True;
try
vsTree.Clear;
LoadCatToTree;
LoadItemToTree;
FNodeEditMode := nemBrowse;
vsTree.FullCollapse;
If vsTree.GetFirst <> Nil then
begin
vsTree.Selected[vsTree.GetFirst] := True;
vsTree.FocusedNode := vsTree.GetFirst;
end;
finally
vsTree.EndUpdate;
FTreeInsert := False;
FNodeEditMode := nemBrowse;
end;
end;

procedure TForm1.btnLoadClick(Sender: TObject);
begin
RefreshTree;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
end;

//Display Text
procedure TForm1.vsTreeGetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: WideString);
var
NodeRec : PPNodeRec;
begin
NodeRec := Sender.GetNodeData(Node);
if not fTreeInsert then
CellText := NodeRec^.Name;
end;

//Dispose record
procedure TForm1.vsTreeFreeNode(Sender: TBaseVirtualTree;
Node: PVirtualNode);
var NodeRec : PPNodeRec;
begin
NodeRec := Sender.GetNodeData(Node);
if assigned(NodeRec^) then
begin
If NodeRec^.NodeType = nCat then //Cat-Nodes can easily disposed
begin
if NodeRec^.RefCount > 0 then //Temporary there may a Refcount during DragMoveOP
dec(NodeRec^.RefCount)
else
begin
Dispose(NodeRec^);
NodeRec^ := Nil;
end;
end
else //can only be a item
begin
If NodeRec^.RefCount > 1 then
Dec(NodeRec^.RefCount) //Decrease RefCount
else //was last Reference
begin
Dispose(NodeRec^);
NodeRec^ := Nil;
end;
end;
end;
end;

//Navigate
procedure TForm1.vsTreeChange(Sender: TBaseVirtualTree;
Node: PVirtualNode);
var NodeRec : PPNodeRec;
begin
NodeRec := Sender.GetNodeData(Node);
If assigned(NodeRec) then
begin
Caption := TNodeTitle[NodeRec^.NodeType]+' : '+NodeRec^.Name;
ReLocateRecord(NodeRec^.NodeType,NodeRec^.ID);
end;
end;

//Provide Node's Image
procedure TForm1.vsTreeGetImageIndex(Sender: TBaseVirtualTree;
Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
var Ghosted: Boolean; var ImageIndex: Integer);
var
NodeRec : PPNodeRec;
begin
NodeRec := Sender.GetNodeData(Node);
If assigned(NodeRec) then
begin
If NodeRec^.NodeType = nCat then
If vsTree.Expanded[Node] then
ImageIndex := 1
else
ImageIndex := 0
else
If Kind = ikSelected then
ImageIndex := 3
else
ImageIndex := 2;
end;
end;

//Ensure DB-Record is Located
Procedure TForm1.ReLocateRecord(ANodeType : TNodeType; ID : Integer);
var
isLocated : Boolean;
begin
if Not (fNodeEditMode = nemInsert) then //Not for New Entries
begin
isLocated := True;
case ANodeType of
nCat : If tblCat.FieldByName('ID').AsInteger <> ID then
isLocated := tblCat.Locate('ID',ID,[]);
nItem: If tblItem.FieldByName('ID').AsInteger <> ID then
isLocated := tblItem.Locate('ID',ID,[]);
end;
if not isLocated then
raise Exception.Create('Record not Found!'+#10+'Please ReLoad Tree');
end;
end;

Procedure TForm1.InsertCat(ANode : PVirtualNode);
var
NodeRec : PPNodeRec;
begin
NodeRec := vsTree.GetNodeData(ANode);
If assigned(NodeRec) then
begin
tblCat.Append;
tblCat.FieldByName('PID').AsInteger := NodeRec^.PID;
tblCat.FieldByName('NAME').AsString := NodeRec^.Name;
tblCat.Post;
NodeRec^.ID := tblCat.FieldByName('ID').AsInteger;
end;
end;

Procedure TForm1.CreateCatItemReference(Cat_ID,Item_ID : Integer);
begin
//qryCreateCatItemRel SQL:
//INSERT INTO CAT_ITEM_REL (CAT_ID, ITEM_ID) VALUES (:CAT_ID,:ITEM_ID)
qryCreateCatItemRel.Parameters[0].Value := Cat_ID;
qryCreateCatItemRel.Parameters[1].Value := Item_ID;
qryCreateCatItemRel.ExecSQL;
end;

Procedure TForm1.InsertItem(ANode : PVirtualNode);
var
NodeRec : PPNodeRec;
begin
NodeRec := vsTree.GetNodeData(ANode);
If assigned(NodeRec) then
begin
tblItem.Append;
tblItem.FieldByName('NAME').AsString := NodeRec^.Name;
tblItem.Post;
NodeRec^.ID := tblItem.FieldByName('ID').AsInteger;
CreateCatItemReference(NodeRec^.PID,NodeRec^.ID);
end;
end;

Procedure TForm1.ModifyCat(ANode : PVirtualNode);
var
NodeRec : PPNodeRec;
begin
NodeRec := vsTree.GetNodeData(ANode);
If assigned(NodeRec) then
begin
ReLocateRecord(NodeRec^.NodeType,NodeRec^.ID);
tblCat.Edit;
tblCat.FieldByName('NAME').AsString := NodeRec^.Name;
tblCat.Post;
end;
end;

Procedure TForm1.ModifyItem(ANode : PVirtualNode);
var
NodeRec : PPNodeRec;
begin
NodeRec := vsTree.GetNodeData(ANode);
If assigned(NodeRec) then
begin
ReLocateRecord(NodeRec^.NodeType,NodeRec^.ID);
tblItem.Edit;
tblItem.FieldByName('NAME').AsString := NodeRec^.Name;
tblItem.Post;
end;
end;

//Sync Data and Tree
Procedure TForm1.SyncModify(ANode : PVirtualNode);
var
NodeRec : PPNodeRec;
begin
NodeRec := vsTree.GetNodeData(ANode);
If assigned(NodeRec) then
begin
Case FNodeEditMode of
nemInsert : begin
Case NodeRec^.NodeType of
nCat : InsertCat(ANode);
nItem : InsertItem(ANode);
end;
end;
nemModify : begin
Case NodeRec^.NodeType of
nCat : ModifyCat(ANode);
nItem : ModifyItem(ANode);
end;
end;
end;
FNodeEditMode := nemBrowse;
end;
end;

//On Confirm Edit
procedure TForm1.vsTreeNewText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; NewText: WideString);
var
NodeRec : PPNodeRec;
begin
NodeRec := vsTree.GetNodeData(Node);
If assigned(NodeRec) then
begin
NodeRec^.Name := NewText;
SyncModify(Node);
tblCat.Refresh;
tblItem.Refresh;
ReSortCat(Node.Parent);
vsTree.Sort(Node.Parent,-1,sdAscending);
vsTree.Sort(Node,-1,sdAscending);
RelocateRecord(NodeRec^.NodeType, NodeRec^.ID);
end;
end;

Procedure TForm1.InsertCatSameLevel;
var
ANode : PVirtualNode;
NewNodeRec : PNodeRec;
NodeRec, P : PPNodeRec;
begin
fTreeInsert := True;
vsTree.BeginUpdate;
try
Anode := vsTree.GetFirstSelected;
If assigned(ANode) then
begin
NodeRec := vsTree.GetNodeData(ANode);
If assigned(NodeRec) then
begin
vsTree.DefaultText := 'New Cat';
New(NewNodeRec);
NewNodeRec^.NodeType := nCat;
NewNodeRec^.PID := NodeRec^.PID;
NewNodeRec^.ID := -1; //Unknown Yet
NewNodeRec^.Name:= 'New Cat';
ANode := vsTree.AddChild(ANode.Parent);
P := vsTree.GetNodeData(ANode);
P^ := NewNodeRec;
fNodeEditMode := nemInsert;
vsTree.Selected[ANode] := True;
vsTree.FocusedNode := ANode;
vsTree.EditNode(ANode,-1);
end;
end;
finally
fTreeInsert := False;
vsTree.EndUpdate;
end;
vsTree.Refresh;
end;

Procedure TForm1.InsertCatSubLevel;
var
ANode : PVirtualNode;
NewNodeRec : PNodeRec;
NodeRec, P : PPNodeRec;
begin
fTreeInsert := True;
vsTree.BeginUpdate;
try
Anode := vsTree.GetFirstSelected;
If assigned(ANode) then
begin
NodeRec := vsTree.GetNodeData(ANode);
If assigned(NodeRec) then
begin
vsTree.DefaultText := 'New Cat';
New(NewNodeRec);
NewNodeRec^.NodeType := nCat;
NewNodeRec^.PID := NodeRec^.ID;
NewNodeRec^.ID := -1; //Unknown Yet
NewNodeRec^.Name:= 'New Cat';
ANode := vsTree.AddChild(ANode);
P := vsTree.GetNodeData(ANode);
P^ := NewNodeRec;
fNodeEditMode := nemInsert;
vsTree.Selected[ANode] := True;
vsTree.FocusedNode := ANode;
vsTree.EditNode(ANode,-1);
end;
end;
finally
fTreeInsert := False;
vsTree.EndUpdate;
end;
vsTree.Refresh;
end;

Procedure TForm1.InsertItemTree;
var
ANode : PVirtualNode;
NewNodeRec : PNodeRec;
NodeRec, P : PPNodeRec;
begin
fTreeInsert := True;
vsTree.BeginUpdate;
try
Anode := vsTree.GetFirstSelected;
If assigned(ANode) then
begin
NodeRec := vsTree.GetNodeData(ANode);
If assigned(NodeRec) then
begin
New(NewNodeRec);
NewNodeRec^.NodeType := nItem;
NewNodeRec^.ID := -1; //Unknown Yet
NewNodeRec^.Name:= 'New Item';
NewNodeRec^.RefCount := 1;
case NodeRec^.NodeType of
nCat : begin //Item must be Added as ChildNode
ANode := vsTree.AddChild(ANode); //Add as Child
NewNodeRec^.PID := NodeRec^.ID; //ID of the Cat-Entry
P := vsTree.GetNodeData(ANode);
P^ := NewNodeRec;
end;
nItem : begin //Item must be Added on Same Level
ANode := vsTree.AddChild(ANode.Parent); //Add same level
NewNodeRec^.PID := NodeRec^.PID; //PID of the other Item
P := vsTree.GetNodeData(ANode);
P^ := NewNodeRec;
end;
end;
fNodeEditMode := nemInsert;
vsTree.Selected[ANode] := True;
vsTree.FocusedNode := ANode;
vsTree.EditNode(ANode,-1);
end;
end;
finally
fTreeInsert := False;
vsTree.EndUpdate;
end;
vsTree.Refresh;
end;

procedure TForm1.btnInsertCatSameLevelClick(Sender: TObject);
begin
If FNodeEditMode = nemBrowse then //Only if nothing is currently Editing
InsertCatSameLevel;
end;

procedure TForm1.btnInsertCatSubLevelClick(Sender: TObject);
begin
If FNodeEditMode = nemBrowse then //Only if nothing is currently Editing
InsertCatSubLevel;
end;

procedure TForm1.btnInsertItemTreeClick(Sender: TObject);
begin
If FNodeEditMode = nemBrowse then //Only if nothing is currently Editing
InsertItemTree;
end;

//Modify, only if not Inserted
procedure TForm1.vsTreeEditing(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean);
begin
If FNodeEditMode = nemBrowse then
FNodeEditMode := nemModify;
end;

//If an Edit is Canceled
procedure TForm1.vsTreeEditCancelled(Sender: TBaseVirtualTree;
Column: TColumnIndex);
var
ANode : PVirtualNode;
begin
If fNodeEditMode = nemInsert then
begin
ANode := vsTree.GetFirstSelected;
ANode := vsTree.GetPreviousVisible(ANode);
if ANode = Nil then
ANode := vsTree.GetNextVisible(ANode);
vsTree.DeleteNode(vsTree.GetFirstSelected);
vsTree.Selected[ANode] := True;
vsTree.FocusedNode := ANode;
end;
fNodeEditMode := nemBrowse;
end;

//Delete a Cat-Item-Relation
Procedure TForm1.DeleteCatItemRelation(CAT_ID, ITEM_ID : Integer);
begin
//qryDeleteCatItemRel SQL:
//DELETE FROM CAT_ITEM_REL WHERE CAT_ID = :CAT_ID AND ITEM_ID = :ITEM_ID
qryDeleteCatItemRel.Parameters[0].Value := Cat_ID;
qryDeleteCatItemRel.Parameters[1].Value := Item_ID;
qryDeleteCatItemRel.ExecSQL;
end;

//Update a Cat-Item-Relation
Procedure TForm1.UpdateCatItemRelation(CAT_ID, CAT_ID_OLD, ITEM_ID : Integer);
begin
//qryUpdateCatItemRel SQL:
//Update Cat_Item_Rel Set Cat_Id = :CAT_ID where Cat_Id = :CAT_ID_OLD and Item_Id = :ITEM_ID
qryUpdateCatItemRel.Parameters[0].Value := Cat_ID;
qryUpdateCatItemRel.Parameters[1].Value := Cat_ID_OLD;
qryUpdateCatItemRel.Parameters[2].Value := Item_ID;
qryUpdateCatItemRel.ExecSQL;
end;

//Delete an Item from tree and DB
procedure TForm1.DeleteItem(ANode : PVirtualNode);
var
NodeRec : PPNodeRec;
begin
NodeRec := vsTree.GetNodeData(ANode);
if assigned(NodeRec) then
begin
RelocateRecord(NodeRec^.NodeType,NodeRec^.Id);
DeleteCatItemRelation(NodeRec^.PID, NodeRec^.Id);
//Dec(NodeRec^.RefCount); //no not Here->the NodeDeletion Decrease the Refcount
if NodeRec^.RefCount = 1 then
begin
RelocateRecord(NodeRec^.NodeType,NodeRec^.Id);
tblItem.Delete;
end;
end;
end;

//Delete a Cat from tree and DB
procedure TForm1.DeleteCat(Anode : PVirtualNode);
var
NodeRec : PPNodeRec;
begin
NodeRec := vsTree.GetNodeData(ANode);
if assigned(NodeRec) then
begin
RelocateRecord(NodeRec^.NodeType,NodeRec^.Id);
tblCat.Delete;
end;
end;

//Delete Dispatcher
procedure TForm1.DeleteObject;
var
ANode : PVirtualNode;
NodeRec : PPNodeRec;
begin
ANode := vsTree.GetFirstSelected;
if assigned(ANode) then
begin
if ANode.ChildCount > 0 then
raise Exception.Create('Only Childless Objects can be Deleted')
else
begin
NodeRec := vsTree.GetNodeData(ANode);
if assigned(NodeRec) then
begin
case NodeRec^.NodeType of
nCat : DeleteCat(ANode);
nItem: DeleteItem(ANode);
end;
ANode := vsTree.GetPreviousVisible(ANode);
if ANode = Nil then
ANode := vsTree.GetNextVisible(ANode);
vsTree.DeleteNode(vsTree.GetFirstSelected);
vsTree.Selected[ANode] := True;
vsTree.FocusedNode := ANode;
end;
end;
end;
end;

procedure TForm1.btnDeleteClick(Sender: TObject);
begin
DeleteObject;
end;

//Evaluate the Drag-Drop-Pair
function TForm1.SetTreeItemTypeSet(SourceNode : PVirtualNode;TargetNode : PVirtualNode) : TDragDropTypes;
var
RefFound : Boolean;
TempNode : PVirtualNode;
TempNodeRec,
SourceNodeRec,
TargetNodeRec : PPNoderec;
begin
//First do as want to Move
Result := [ddtMove];
//Get Shift Key
if (GetAsyncKeyState(VK_SHIFT) OR $FFFF) = -1 then
Result := Result + [ddtSort] - [ddtMove];

//Get Control Key
if (GetAsyncKeyState(VK_CONTROL) OR $FFFF) = -1 then
Result := Result + [ddtCopy] - [ddtMove];

//Get NodeRecs
SourceNodeRec := vsTree.GetNodeData(SourceNode);
TargetNodeRec := vsTree.GetNodeData(TargetNode);
//Is there any Target
If not Assigned(TargetNode) then
Result := Result + [ddtTargetNone]
else
//Both have same Parent
if SourceNode.Parent = TargetNode.Parent then
Result := Result + [ddtSameParent]
else
//Target is Source Parent
if SourceNode.Parent = TargetNode then
Result := Result + [ddtSourceOnParent];

//Source is Root and Target is None
If (SourceNode.Parent = vsTree.RootNode) and
(ddtTargetNone in Result) then
Result := Result + [ddtSameParent];

//Source = Target
if SourceNode = TargetNode then
Result := Result + [ddtSourceOnSelf];

//Determine, What Kind of Node is the Source
If Assigned(SourceNodeRec) then
case SourceNodeRec^.NodeType of
nCat : Result := Result + [ddtSourceCat];
nItem : Result := Result + [ddtSourceItem];
end;

//Determine, What Kind of Node is the Target
If Assigned(TargetNodeRec) then
Case TargetNodeRec^.NodeType of
nCat : Result := Result + [ddtTargetCat];
nItem : Result := Result + [ddtTargetItem];
end;

//Check Recursion
If (assigned(TargetNode)) and
(SourceNodeRec^.NodeType = nCat) and
(ddtMove in Result) then
begin
TempNode := TargetNode.Parent;
while (assigned(TempNode)) and (TempNode <> SourceNode) do
TempNode := TempNode.Parent;
If assigned(TempNode) then
Result := Result + [ddtCatRecursion];
end;

//Check for Item reference
If (assigned(TargetNode)) and
(SourceNodeRec^.NodeType = nItem) then
begin
if TargetNodeRec^.NodeType = nCat then
TempNode := TargetNode
else
TempNode := TargetNode.Parent;

TempNode := TempNode.FirstChild;
RefFound := False;
while assigned(TempNode) and (not(RefFound)) do
begin
TempNodeRec := vsTree.GetNodeData(TempNode);
if (assigned(TempNodeRec)) and
(TempNodeRec^.NodeType = nItem) and
(TempNodeRec^.ID = SourceNodeRec^.ID) then
RefFound := True;
if Not RefFound then
TempNode := TempNode.NextSibling;
end;
if assigned(TempNode) then
Result := Result + [ddtItemRefExists];
end;

end;

//Begin to Drag?
procedure TForm1.vsTreeMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var ANode : PVirtualNode;
begin
ANode := vsTree.GetFirstSelected;
if (FNodeEditMode = nemBrowse) and
(ssLeft in Shift) and
(not FInDrag) and
(Assigned(ANode)) then
begin
vsTree.BeginDrag(False,12);
FInDrag := True;
end;
end;

//End of Drag, No Op
procedure TForm1.vsTreeMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FInDrag := False;
vsTree.Refresh;
end;

procedure TForm1.vsTreeDragOver(Sender: TBaseVirtualTree; Source: TObject;
Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode;
var Effect: Integer; var Accept: Boolean);

var
TargetNode : PVirtualNode;
DragSet : TDragDropTypes;
begin
TargetNode := vsTree.DropTargetNode;
DragSet := SetTreeItemTypeSet(vsTree.GetFirstSelected,TargetNode);
Accept := (DragSet = daCopyDropCatRoot) or
(DragSet = daMoveDropCatRoot) or
(DragSet = daCopyDropCatOnCat) or
(DragSet = daMoveDropCatOnCatWithSameParent) or
(DragSet = daCopyDropCatOnCatWithSameParent) or
(DragSet = daMoveDropCatOnCat) or
(DragSet = daSortDropCatOnCat) or
(DragSet = daCopyDropItemOnItem) or
(DragSet = daMoveDropItemOnItem) or
(DragSet = daCopyDropItemOnCat) or
(DragSet = daMoveDropItemOnCat) or
(DragSet = daCopyDropItemOnCatWithSameParent) or
(DragSet = daMoveDropItemOnCatWithSameParent);

//Just for Visual Checking DragSet
CheckBox1.Checked := ddtTargetNone in DragSet;
CheckBox2.Checked := ddtTargetCat in DragSet;
CheckBox3.Checked := ddtTargetItem in DragSet;
CheckBox4.Checked := ddtSourceCat in DragSet;
CheckBox5.Checked := ddtSourceItem in DragSet;
CheckBox6.Checked := ddtSourceOnParent in DragSet;
CheckBox7.Checked := ddtSourceOnSelf in DragSet;
CheckBox8.Checked := ddtSameParent in DragSet;
CheckBox9.Checked := ddtCatRecursion in DragSet;
CheckBox10.Checked := ddtItemRefExists in DragSet;
CheckBox11.Checked := ddtCopy in DragSet;
CheckBox12.Checked := ddtMove in DragSet;
CheckBox13.Checked := ddtSort in DragSet;
Application.ProcessMessages;
//End of Just for Visual Checking DragSet
//Remove part if never needed

end;

//Drop Event
procedure TForm1.vsTreeDragDrop(Sender: TBaseVirtualTree; Source: TObject;
DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState;
Pt: TPoint; var Effect: Integer; Mode: TDropMode);
var
SourceNode,
TargetNode : PVirtualNode;
DragSet : TDragDropTypes;
begin
TargetNode := vsTree.DropTargetNode;
SourceNode := vsTree.GetFirstSelected;
DragSet := SetTreeItemTypeSet(SourceNode,TargetNode);
if DragSet = daCopyDropCatRoot then doCopyCat(Nil,SourceNode)
else if DragSet = daMoveDropCatRoot then doMoveCat(Nil,SourceNode)
else if DragSet = daCopyDropCatOnCat then doCopyCat(TargetNode,SourceNode)
else if DragSet = daMoveDropCatOnCat then doMoveCat(TargetNode,SourceNode)
else if DragSet = daCopyDropCatOnCatWithSameParent then doCopyCat(TargetNode,SourceNode)
else if DragSet = daMoveDropCatOnCatWithSameParent then doMoveCat(TargetNode,SourceNode)
else if DragSet = daSortDropCatOnCat then doSortCat(TargetNode,SourceNode)
else if DragSet = daCopyDropItemOnItem then doCopyItem(TargetNode.Parent,SourceNode)
else if DragSet = daMoveDropItemOnItem then doMoveItem(TargetNode.Parent,SourceNode)
else if DragSet = daCopyDropItemOnCat then doCopyItem(TargetNode,SourceNode)
else if DragSet = daMoveDropItemOnCat then doMoveItem(TargetNode,SourceNode)
else if DragSet = daCopyDropItemOnCatWithSameParent then doCopyItem(TargetNode,SourceNode)
else if DragSet = daMoveDropItemOnCatWithSameParent then doMoveItem(TargetNode,SourceNode);
FInDrag := False;
end;

//Set Prio-Sequence for a ParentNode
Procedure TForm1.ReSortCat(ParentNode : PVirtualNode);
var
TempNode : PVirtualNode;
TempNodeRec : PPNoderec;
i : Integer;
begin
If Assigned(ParentNode) then
begin
TempNode := ParentNode.FirstChild;
i := 1;
while assigned(TempNode) do
begin
TempNodeRec := vsTree.GetNodeData(TempNode);
if TempNodeRec^.NodeType = nCat then
begin
if TempNodeRec^.Priority <> i then
begin
ReLocateRecord(TempNodeRec^.NodeType,TempNodeRec^.ID);
tblCat.Edit;
tblCat.FieldByName('PRIO').AsInteger := i;
tblCat.Post;
TempNodeRec^.Priority := i;
end;
inc(i);
end;
TempNode := TempNode.NextSibling;
end;
end;
end;

Procedure TForm1.doCopyCat(TargetNode, SourceNode : PVirtualNode);
begin
//Not implemented yet
end;

Procedure TForm1.doMoveCat(TargetNode, SourceNode : PVirtualNode);
var
NewNode : PVirtualNode;
NewNodeRec,
SourceNodeRec,
TargetNodeRec : PPNoderec;
begin
//Get NodeRecs
SourceNodeRec := vsTree.GetNodeData(SourceNode);
TargetNodeRec := vsTree.GetNodeData(TargetNode);
vsTree.BeginUpdate;
try
ReLocateRecord(SourceNodeRec^.NodeType,SourceNodeRec^.ID);
tblCat.Edit;
If assigned(TargetNode) then
begin
tblCat.FieldByName('PID').AsInteger := TargetNodeRec^.ID;
SourceNodeRec^.PID := TargetNodeRec^.ID;
end
else
begin
tblCat.FieldByName('PID').AsInteger := 0;
SourceNodeRec^.PID := 0;
end;
tblCat.Post;
FTreeInsert := True;
NewNode := vsTree.AddChild(TargetNode);
NewNodeRec := vsTree.GetNodeData(NewNode);
NewNodeRec^ := SourceNodeRec^;
Inc(NewNodeRec^.RefCount);
NewNodeRec^.Priority := 1;
vsTree.MoveTo(SourceNode,NewNode,amAddChildLast,True);
FTreeInsert := False;
//Set New Prios
ReSortCat(TargetNode);
ReSortCat(SourceNode.Parent);
//Sort
vsTree.Sort(TargetNode,-1,sdAscending);
vsTree.Sort(SourceNode.Parent,-1,sdAscending);
//Select New Node
vsTree.Selected[NewNode] := True;
vsTree.FocusedNode := NewNode;
finally
vsTree.EndUpdate;
end;
vsTree.Refresh;
end;

//the Source is allways inserted before the Target
Procedure TForm1.doSortCat(TargetNode, SourceNode : PVirtualNode);
var
NewNode : PVirtualNode;
NewNodeRec,
SourceNodeRec,
TargetNodeRec : PPNoderec;
begin
//Get NodeRecs
SourceNodeRec := vsTree.GetNodeData(SourceNode);
TargetNodeRec := vsTree.GetNodeData(TargetNode);
vsTree.BeginUpdate;
vsTree.OnCompareNodes := Nil; //Temporary disable Sorting
try

NewNode := vsTree.InsertNode(TargetNode,amInsertBefore);
NewNodeRec := vsTree.GetNodeData(NewNode);
NewNodeRec^ := SourceNodeRec^;
Inc(NewNodeRec^.RefCount);
NewNodeRec^.Priority := TargetNodeRec^.Priority;

//First Child
vsTree.MoveTo(SourceNode,NewNode,amAddChildLast,True);
//then Node
vsTree.MoveTo(SourceNode,NewNode,amAddChildLast,False);

FTreeInsert := False;
//Set New Prios
ReSortCat(TargetNode.Parent);
//Select New Node
vsTree.Selected[NewNode] := True;
vsTree.FocusedNode := NewNode;
finally
vsTree.EndUpdate;
vsTree.OnCompareNodes := vsTreeCompareNodes; //enable Sorting
//Sort
vsTree.Sort(TargetNode.Parent,-1,sdAscending);
end;
vsTree.Refresh;
end;

Procedure TForm1.doCopyItem(TargetNode, SourceNode : PVirtualNode);
begin
end;

Procedure TForm1.doMoveItem(TargetNode, SourceNode : PVirtualNode);
var
TempNode,
NewNode : PVirtualNode;
TempNodeRec,
NewNodeRec,
SourceNodeRec,
TargetNodeRec : PPNoderec;
begin
//Get NodeRecs
SourceNodeRec := vsTree.GetNodeData(SourceNode);
TargetNodeRec := vsTree.GetNodeData(TargetNode);
vsTree.BeginUpdate;
try
UpdateCatItemRelation(TargetNodeRec^.ID,SourceNodeRec^.PID,SourceNodeRec^.ID);
FTreeInsert := True;
NewNode := vsTree.AddChild(TargetNode);
NewNodeRec := vsTree.GetNodeData(NewNode);
NewNodeRec^ := SourceNodeRec^;
NewNodeRec^.PID := TargetNodeRec^.ID;
Inc(NewNodeRec^.RefCount);
vsTree.MoveTo(SourceNode,NewNode,amAddChildLast,True);
FTreeInsert := False;
//Sort Target
vsTree.Sort(TargetNode,-1,sdAscending);
//Select New Node
vsTree.Selected[NewNode] := True;
vsTree.FocusedNode := NewNode;
finally
vsTree.EndUpdate;
end;
vsTree.Refresh;
end;

//Sorting Rules
procedure TForm1.vsTreeCompareNodes(Sender: TBaseVirtualTree; Node1,
Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
var
Node1Rec,
Node2Rec : PPNoderec;
begin
//Only, if Not currently Inserting
If Not FTreeInsert then
begin
//Get NodeRecs
Node1Rec := vsTree.GetNodeData(Node1);
Node2Rec := vsTree.GetNodeData(Node2);
Case Node1Rec^.NodeType of
nCat : case Node2Rec^.NodeType of
nCat : If Node1Rec^.Priority < Node2Rec^.Priority then
Result := -1
else
Result := 1;
nItem: Result := -1;
end;
nItem: case Node2Rec^.NodeType of
nCat : Result := 1;
nItem: If Node1Rec^.Name < Node2Rec^.Name then
Result := -1
else
Result := 1;
end;
end;
end;
end;

end.

meikl ;-)

morgantop

ASKER

thanks kretzschmar.
you have helped me big time.