?
Solved

Adjusting the Folder node button.

Posted on 2009-07-14
4
Medium Priority
?
197 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
4 Comments
 
LVL 18

Accepted Solution

by:
Johnjces earned 2000 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

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
In this brief tutorial Pawel from AdRem Software explains how you can quickly find out which services are running on your network, or what are the IP addresses of servers responsible for each service. Software used is freeware NetCrunch Tools (https…
Add bar graphs to Access queries using Unicode block characters. Graphs appear on every record in the color you want. Give life to numbers. Hopes this gives you ideas on visualizing your data in new ways ~ Create a calculated field in a query: …
Suggested Courses
Course of the Month12 days, 23 hours left to enroll

777 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