Solved

Adjusting the Folder node button.

Posted on 2009-07-14
4
187 Views
Last Modified: 2012-05-07
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
0
Comment
Question by:peterkiers
  • 3
4 Comments
 
LVL 18

Accepted Solution

by:
Johnjces earned 500 total points
ID: 24850891
Here you need to add an ImageList and add the folder icons and other icons you desire. Then call the icon for that node.

TreeView1.Items[X].ImageIndex := 2;
0
 
LVL 1

Author Comment

by:peterkiers
ID: 24851151

I'm not able to make a subfolder in a folder with this procedure:

procedure TForm1.FolderBtnClick(Sender: TObject);
var aText: string;
begin
  if InputQuery('Folder', 'Enter a folder name', aText) then
    AddItem(aText, 15, nil);
end;

0
 
LVL 1

Author Comment

by:peterkiers
ID: 24851778
This is a start:

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;
0
 
LVL 1

Author Comment

by:peterkiers
ID: 24860648
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.

Open in new window

0

Featured Post

Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
Sending a Secure fax is easy with eFax Corporate (http://www.enterprise.efax.com). First, Just open a new email message.  In the To field, type your recipient's fax number @efaxsend.com. You can even send a secure international fax — just include t…
Here's a very brief overview of the methods PRTG Network Monitor (https://www.paessler.com/prtg) offers for monitoring bandwidth, to help you decide which methods you´d like to investigate in more detail.  The methods are covered in more detail in o…

705 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now