Adjusting the Folder node button.
Dear Experts,
I have made a little programm that has a Treeview, a RichEdit.
and 4 buttons on a Panel. 2 buttons are for loading and saving
the treeview nodes with its associating text on the RichtEdit
to a database. The other 2 buttons are for creating a Folder-node
and a File-node in the Treeview. Everything works perfect.
Accept with the Folder node button I am not able to make a sub-folder node
and I want when a Folder is chosen that the openfolder-icon is displayed.
Who can help me with this?
I have put the example on my site:
http://members.home.nl/peterkiers/
You see a floppy disc.
Greetings, Peter Kiers
I have made a little programm that has a Treeview, a RichEdit.
and 4 buttons on a Panel. 2 buttons are for loading and saving
the treeview nodes with its associating text on the RichtEdit
to a database. The other 2 buttons are for creating a Folder-node
and a File-node in the Treeview. Everything works perfect.
Accept with the Folder node button I am not able to make a sub-folder node
and I want when a Folder is chosen that the openfolder-icon is displayed.
Who can help me with this?
I have put the example on my site:
http://members.home.nl/peterkiers/
You see a floppy disc.
Greetings, Peter Kiers
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
This is a start:
procedure TForm1.FolderBtnClick(Send
var aText: string;
aParent: TTreeNode;
begin
aParent := nil;
if TreeView1.Selected <> nil then
begin
if TreeView1.Selected.ImageIn
aParent := TreeView1.Selected
else
begin
ShowMessage('Select a folder first');
Exit;
end;
end;
if InputQuery('Folder', 'Enter a folder name', aText) then
AddItem(aText, 15, aParent);
end;
procedure TForm1.FolderBtnClick(Send
var aText: string;
aParent: TTreeNode;
begin
aParent := nil;
if TreeView1.Selected <> nil then
begin
if TreeView1.Selected.ImageIn
aParent := TreeView1.Selected
else
begin
ShowMessage('Select a folder first');
Exit;
end;
end;
if InputQuery('Folder', 'Enter a folder name', aText) then
AddItem(aText, 15, aParent);
end;
ASKER
I guess no one will download the example. So i have put the code in the code-section.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DB, ADODB, ComCtrls, StdCtrls, ImgList, ExtCtrls;
type
TForm1 = class(TForm)
TreeView1: TTreeView;
Splitter1: TSplitter;
Panel1: TPanel;
Button1: TButton;
Button2: TButton;
ADOQuery1: TADOQuery;
ADOConnection1: TADOConnection;
FolderBtn: TButton;
FileBtn: TButton;
ImageList1: TImageList;
RichEdit1: TRichEdit;
Button3: TButton;
procedure Button3Click(Sender: TObject);
procedure RichEdit1KeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FolderBtnClick(Sender: TObject);
procedure FileBtnClick(Sender: TObject);
procedure TreeView1Change(Sender: TObject; Node: TTreeNode);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
procedure savetree(t: ttreeview);
procedure loadtree(t: TTreeView);
procedure saveNode(n: TTreeNode);
function findNode(t:TTreeView; id: integer): TTreeNode;
procedure AddItem(aText: string; aIndex: Integer; aParent: TTreeNode);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
type
TItem = class(TObject)
private
fStatus: byte;
fParentID: integer;
fNodeText: string;
fID: integer;
fData: string;
fSaver: TAdoQuery;
fChanged: Boolean;
fSaveImmediate: boolean;
fIsNew: Boolean;
fImageIndex: integer;
procedure SetData(const Value: string);
procedure SetNodeText(const Value: string);
procedure SetParentID(const Value: integer);
procedure SetStatus(const Value: byte);
procedure SetImageIndex(const Value: integer);
protected
procedure Changed; dynamic;
public
constructor Create(aSaver: TAdoQuery; AId, AParentID: integer; AStatus: byte);
constructor LoadFromDataset(aSaver: TAdoQuery);
procedure BeginUpdate;
procedure EndUpdate;
procedure Delete;
procedure Save;
published
property ID: integer read fID write fID;
property ParentID: integer read fParentID write SetParentID;
property ImageIndex: integer read fImageIndex write SetImageIndex;
property Status: byte read FStatus write SetStatus;
property Data: string read fData write SetData;
property NodeText: string read fNodeText write SetNodeText;
end;
{ TItem }
procedure TItem.BeginUpdate;
begin
fSaveImmediate := false;
end;
(*---------------------------------------------------*)
procedure TItem.Changed;
begin
fChanged := True;
if fSaveImmediate then Save;
end;
(*---------------------------------------------------*)
constructor TItem.Create(aSaver: TAdoQuery; AId, AParentID: integer;
AStatus: byte);
begin
inherited Create;
fChanged := False;
fSaveImmediate := True;
fIsNew := True;
fSaver := aSaver;
fID := AID;
fParentID := AParentID;
fStatus := AStatus;
fNodeText := '';
fData := '';
end;
(*---------------------------------------------------*)
procedure TItem.Delete;
begin
//
end;
(*---------------------------------------------------*)
procedure TItem.EndUpdate;
begin
fSaveImmediate := True;
if fChanged then Save;
end;
(*---------------------------------------------------*)
constructor TItem.LoadFromDataset(aSaver: TAdoQuery);
begin
Create(aSaver, 0, 0, 0);
if not aSaver.IsEmpty then
begin
fId := aSaver.FieldByName('ID').AsInteger;
fParentID := aSaver.FieldByName('PARENT').AsInteger;
fStatus := aSaver.FieldByName('STATUS').AsInteger;
fNodeText := aSaver.FieldByName('NAME').AsString;
if aSaver.FindField('DATA') <> nil then
fData := aSaver.FieldByName('DATA').AsString;
fImageIndex := aSaver.FieldByName('IMAGE_INDEX').AsInteger;
fIsNew := False;
end;
end;
(*---------------------------------------------------*)
procedure TItem.Save;
begin
if fIsNew then
fSaver.SQL.Text :=
'insert into tree (parent, name, status, image_index, data) values (:v1, :v2, :v3, :v4, :v5)'
else
fSaver.SQL.Text :=
'update tree set parent = :v1, name = :v2, status = :v3, image_index = :v4, data = :v5 where id = :v6';
fSaver.Parameters.ParamByName('v1').Value := fparentID;
fSaver.Parameters.ParamByName('v2').Value := fNodeText;
fSaver.Parameters.ParamByName('v3').Value := fStatus;
fSaver.Parameters.ParamByName('v4').Value := fImageIndex;
fSaver.Parameters.ParamByName('v5').Value := fData;
if not fIsNew then
fSaver.Parameters.ParamByName('v6').Value := fId;
fSaver.ExecSQL;
if fIsNew then
begin
fSaver.SQL.Text :=
'SELECT id from tree order by id desc';
fSaver.Open;
fId := fSaver.FieldByName('ID').asInteger;
fSaver.Close;
fIsNew := False;
end;
fChanged := False;
end;
(*---------------------------------------------------*)
procedure TItem.SetData(const Value: string);
begin
if fData <> Value then
begin
fData := Value;
Changed;
end;
end;
(*---------------------------------------------------*)
procedure TItem.SetImageIndex(const Value: integer);
begin
if fImageIndex <> Value then
begin
fImageIndex := Value;
Changed;
end;
end;
(*---------------------------------------------------*)
procedure TItem.SetNodeText(const Value: string);
begin
if fNodeText <> Value then
begin
fNodeText := Value;
Changed;
end;
end;
(*---------------------------------------------------*)
procedure TItem.SetParentID(const Value: integer);
begin
if fParentId <> Value then
begin
fParentID := Value;
Changed;
end;
end;
(*---------------------------------------------------*)
procedure TItem.SetStatus(const Value: byte);
begin
if fStatus <> Value then
begin
FStatus := Value;
Changed;
end;
end;
(*---------------------------------------------------*)
procedure TForm1.AddItem(aText: string; aIndex: Integer; aParent: TTreeNode);
var n: TTreeNode;
data: TItem;
parentId: integer;
begin
parentId := 0;
if (aParent <> nil) and (TItem(aParent.Data) <> nil) then
parentId := TItem(aParent.Data).ID;
data := TItem.Create(AdoQuery1, -1, parentId, 0);
data.NodeText := aText;
data.ImageIndex := aIndex;
n := TTreeNode.Create(TreeView1.Items);
n.Text := data.NodeText;
n.ImageIndex := data.ImageIndex;
n.SelectedIndex := data.ImageIndex;
TreeView1.Items.AddNode(n, aParent, aText, data, naAddChild);
end;
(*---------------------------------------------------*)
procedure TForm1.Button1Click(Sender: TObject);
begin
loadTree(treeview1);
end;
(*---------------------------------------------------*)
procedure TForm1.Button2Click(Sender: TObject);
begin
savetree(treeview1);
end;
procedure TForm1.Button3Click(Sender: TObject);
var
node : TTreeNode;
mess, str : string;
key_stat : integer;
begin
Node := Treeview1.Selected;
if Assigned(Node) then
begin
str := Node.Text;
mess := 'Are you sure that you want to delete the';
Case Node.Level of
0 : mess := mess + ' folder : ' +#13+#13 + str + ' ???' +#13+
'All folders, subfolders, items and subitems' +#13+ 'will be permanently deleted !!' +#13;
1 : mess := mess + ' item : ' +#13+#13 + str + ' ???' + #13;
end;
with Application do
begin
NormalizeTopMosts;
key_stat := MessageBox(pchar(mess), ' Confirmation', MB_YESNO);
RestoreTopMosts;
end;
if key_stat = 7 then Exit; // 6 - YES ; 7 - N0
TreeView1.Items.Delete(Treeview1.Selected);
end
else ShowMessage('Select a folder in the treeview first.');
end;
(*---------------------------------------------------*)
procedure TForm1.FileBtnClick(Sender: TObject);
var aText: string;
begin
if (TreeView1.Selected <> nil) and (TreeView1.Selected.ImageIndex = 15) then
begin
if InputQuery('File', 'Enter a file name', aText) then
AddItem(aText, 17, TreeView1.Selected);
end else
ShowMessage('Select a folder in the treeview first.');
end;
(*---------------------------------------------------*)
function TForm1.findNode(t: TTreeView; id: integer): TTreeNode;
var i:integer;
begin
i:=0;
while (i<t.items.count) and (TItem(t.items[i].data).ID<>id) do
inc(i);
if i<t.items.count then result:=t.items[i]
else result:=nil;
end;
(*---------------------------------------------------*)
procedure TForm1.FolderBtnClick(Sender: TObject);
var aText: string;
aParent: TTreeNode;
begin
aParent := nil;
if TreeView1.Selected <> nil then
begin
if TreeView1.Selected.ImageIndex = 15 then
aParent := TreeView1.Selected
else
begin
ShowMessage('Select a folder first');
Exit;
end;
end;
if InputQuery('Folder', 'Enter a folder name', aText) then
AddItem(aText, 15, aParent);
end;
(*---------------------------------------------------*)
procedure TForm1.FormCreate(Sender: TObject);
var
conn_str:string;
begin
conn_str:='provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source=';
conn_str:=conn_str+IncludeTrailingPathDelimiter(ExtractFilePath(Application.Exename));
conn_str:=conn_str+'test.pkd;';
ADOConnection1.Connected:=False;
ADOConnection1.ConnectionString:=conn_str;
ADOConnection1.Connected:=True;
ADOConnection1.Open;
end;
(*---------------------------------------------------*)
procedure TForm1.loadtree(t: TTreeView);
var
p, n: TTreeNode;
data: TItem;
begin
t.Items.Clear;
ADOQuery1.SQL.Text := 'select * from tree order by parent asc';
ADoQuery1.Open;
while not ADoQuery1.Eof do
begin
data := TItem.LoadFromDataset(AdoQuery1);
p := FindNode(t, data.ParentID);
n := t.items.AddChildObject(p, data.NodeText, data);
n.ImageIndex := data.ImageIndex;
n.SelectedIndex := data.ImageIndex;
AdoQuery1.Next;
end;
AdoQuery1.Close;
end;
(*---------------------------------------------------*)
procedure TForm1.saveNode(n: TTreeNode);
var i, aParent: integer;
item: TItem;
begin
item := TItem(n.Data);
if item <> nil then
begin
item.BeginUpdate;
try
Item.NodeText := n.Text;
aParent := 0;
if (n.Parent <> nil) and (TItem(n.Parent.Data) <> nil) then
aParent := TItem(n.Parent.Data).ID;
Item.ParentID := aParent;
Item.ImageIndex := n.ImageIndex;
finally
Item.EndUpdate;
end;
end;
for i := 0 to n.Count-1 do SaveNode(n.Item[i]);
end;
(*---------------------------------------------------*)
procedure TForm1.savetree(t: ttreeview);
var n: TTreeNode;
begin
n := t.items.getFirstNode;
while n <> nil do
begin
SaveNode(n);
n := n.getNextSibling;
end;
end;
(*---------------------------------------------------*)
procedure TForm1.TreeView1Change(Sender: TObject; Node: TTreeNode);
begin
RichEdit1.Text := '';
if (Node <> nil) and (Node.ImageIndex = 15) then
RichEdit1.Text := TItem(Node.Data).Data;
end;
(*---------------------------------------------------*)
procedure TForm1.RichEdit1KeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
var n: TTreeNode;
begin
n := TreeView1.Selected;
if (n <> nil) and (n.ImageIndex = 15) then
begin
TItem(n.Data).fSaveImmediate := False;
TItem(N.Data).Data := RichEdit1.Text;
end;
end;
(*---------------------------------------------------*)
end.
ASKER
I'm not able to make a subfolder in a folder with this procedure:
procedure TForm1.FolderBtnClick(Send
var aText: string;
begin
if InputQuery('Folder', 'Enter a folder name', aText) then
AddItem(aText, 15, nil);
end;