home *** CD-ROM | disk | FTP | other *** search
- unit CakTreeView;
- // Common Archiver Kit (CAK) List View
- // Common Interface for Compression/Decompression components.
-
- //Copyright (C) Joseph Leung 2001 (lycj@yahoo.com)
- //
- //This library is free software; you can redistribute it and/or
- //modify it under the terms of the GNU Lesser General Public
- //License as published by the Free Software Foundation; either
- //version 2.1 of the License, or (at your option) any later version.
- //
- //This library is distributed in the hope that it will be useful,
- //but WITHOUT ANY WARRANTY; without even the implied warranty of
- //MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- //Lesser General Public License for more details.
- //
- //You should have received a copy of the GNU Lesser General Public
- //License along with this library; if not, write to the Free Software
- //Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-
- // ver 0.1.0.0
- // lastupdate 4.12.2001
- interface
-
- uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- ComCtrls, CakDir;
-
- type
- TCAKTreeView = class(TTreeView)
- private
- { Private declarations }
- protected
- { Protected declarations }
- public
- CakDir : TCakDir;
- DirNode : TTreeNode;
- procedure ReloadCAK;
- constructor Create( AOwner: TComponent ); override;
- destructor Destroy; override;
- procedure add2tree(node: TTreeNode; name, fullname: string);
- function getselectedpath : string;
- { Public declarations }
- published
- property CakitDir : TCakDir read CakDir write CakDir;
- { Published declarations }
- end;
-
- procedure Register;
-
- implementation
- function TCAKTreeView.getselectedpath : string;
- var k : string;
- dummynode : ttreenode;
- begin
- if not selected.HasAsParent(Dirnode) then
- result := '' else
- if selected = Dirnode then result := '' else
- begin
- dummynode := selected;
- while not (dummynode = Dirnode) do
- begin
- k := dummynode.Text + '\' + k;
- dummynode := dummynode.Parent;
- end;
- result := k;
- end;
- end;
- procedure TCAKTreeView.add2tree(node: TTreenode; name, fullname: string);
- var
- NewItem: TTreeNode;//TTReeNode;
- k, l: string;
- i, j: integer;
- begin
-
- k := CakDir.modifyslash(name);
-
- if length(k) >= 1 then
- if k[1] = '\' then k := Copy(k, 2, length(k));
- if length(k) = 0 then exit;
- l := '';
- i := 0;
- begin
- while (i < length(k)) and (k[i] <> '\') do
- begin
- i := i + 1;
- end;
- if k[i] = '\' then
- begin
- l := Copy(k, i + 1, length(k) - i);
- k := Copy(k, 0, i - 1);
- end;
- j := 0;
- if (node.Count >= 1) and (j <= node.Count) then
- while (j < node.Count - 1) and (k <> node.Item[j].Text) do
- begin
- if assigned(node) then
- j := j + 1
- else
- exit;
- end;
-
- if node.Count > 0 then
- if k = node.Item[j].Text then
- begin
- if length(l) > 1 then
- add2tree(node.item[j], l, fullname);
- exit;
- end;
-
- NewItem := Items.AddChild(node, k);
- Newitem.Text := k;
- Newitem.ImageIndex := 1;
- Newitem.SelectedIndex := 1;
-
- if length(l) > 1 then
- add2tree(newitem, l, fullname);
- end;
- end;
- procedure TCakTreeview.ReloadCAK;
- var i : integer;
- begin
- items.Clear;
- DirNode := items.Add(nil ,'{Dir View}');
- DirNode.Text := '{DirView}';
- DirNode.ImageIndex := 0;
- DirNode.SelectedIndex := 0;
-
-
- if not assigned(CakDir) then exit;
- if CakDir.DirectoryList.Count = 0 then exit;
- for i := 0 to CakDir.DirectoryList.Count -1 do
- add2tree(Dirnode, CAKDIr.DirectoryList.strings[i],CAKDIr.DirectoryList.strings[i]);
-
- DirNode.Expand(false);
- end;
-
- constructor TCakTreeview.Create( AOwner: TComponent );
- begin
- inherited Create( AOwner );
- end;
- destructor TCakTreeview.Destroy;
- begin
- inherited Destroy;
- end;
- procedure Register;
- begin
- RegisterComponents('QZip', [TCakTreeView]);
- end;
-
- end.
-