home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 March / Chip_2002-03_cd1.bin / zkuste / delphi / kompon / d5 / cak / CAKDIR.ZIP / CAKTreeView.pas < prev    next >
Pascal/Delphi Source File  |  2001-04-17  |  4KB  |  152 lines
  1. unit CakTreeView;
  2. // Common Archiver Kit (CAK) List View
  3. // Common Interface for Compression/Decompression components.
  4.  
  5. //Copyright (C) Joseph Leung 2001 (lycj@yahoo.com)
  6. //
  7. //This library is free software; you can redistribute it and/or
  8. //modify it under the terms of the GNU Lesser General Public
  9. //License as published by the Free Software Foundation; either
  10. //version 2.1 of the License, or (at your option) any later version.
  11. //
  12. //This library is distributed in the hope that it will be useful,
  13. //but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. //MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15. //Lesser General Public License for more details.
  16. //
  17. //You should have received a copy of the GNU Lesser General Public
  18. //License along with this library; if not, write to the Free Software
  19. //Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  20.  
  21. // ver 0.1.0.0
  22. // lastupdate 4.12.2001
  23. interface
  24.  
  25. uses
  26.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  27.   ComCtrls, CakDir;
  28.  
  29. type
  30.   TCAKTreeView = class(TTreeView)
  31.   private
  32.     { Private declarations }
  33.   protected
  34.     { Protected declarations }
  35.   public
  36.     CakDir : TCakDir;
  37.     DirNode : TTreeNode;
  38.     procedure ReloadCAK;
  39.     constructor Create( AOwner: TComponent ); override;
  40.     destructor Destroy; override;
  41.     procedure add2tree(node: TTreeNode; name, fullname: string);
  42.     function getselectedpath : string;
  43.     { Public declarations }
  44.   published
  45.     property CakitDir : TCakDir read CakDir write CakDir;
  46.     { Published declarations }
  47.   end;
  48.  
  49. procedure Register;
  50.  
  51. implementation
  52. function TCAKTreeView.getselectedpath : string;
  53. var k : string;
  54.     dummynode : ttreenode;
  55. begin
  56.         if not selected.HasAsParent(Dirnode) then
  57.                 result := '' else
  58.         if selected = Dirnode then result := '' else
  59.         begin
  60.         dummynode := selected;
  61.         while not (dummynode = Dirnode) do
  62.                 begin
  63.                         k := dummynode.Text + '\' + k;
  64.                         dummynode := dummynode.Parent;
  65.                 end;
  66.         result := k;
  67.         end;
  68. end;
  69. procedure TCAKTreeView.add2tree(node: TTreenode; name, fullname: string);
  70. var
  71.   NewItem: TTreeNode;//TTReeNode;
  72.   k, l:    string;
  73.   i, j:    integer;
  74. begin
  75.  
  76.     k := CakDir.modifyslash(name);
  77.  
  78.     if length(k) >= 1 then
  79.       if k[1] = '\' then k := Copy(k, 2, length(k));
  80.     if length(k) = 0 then exit;
  81.     l := '';
  82.     i := 0;
  83.     begin
  84.       while (i < length(k)) and (k[i] <> '\') do
  85.       begin
  86.         i := i + 1;
  87.       end;
  88.       if k[i] = '\' then
  89.       begin
  90.         l := Copy(k, i + 1, length(k) - i);
  91.         k := Copy(k, 0, i - 1);
  92.       end;
  93.       j := 0;
  94.       if (node.Count >= 1) and (j <= node.Count) then
  95.         while (j < node.Count - 1) and (k <> node.Item[j].Text) do
  96.         begin
  97.           if assigned(node) then
  98.             j := j + 1 
  99.           else
  100.             exit;
  101.         end;         
  102.  
  103.       if node.Count > 0 then
  104.         if k = node.Item[j].Text then
  105.         begin
  106.           if length(l) > 1 then
  107.             add2tree(node.item[j], l, fullname);
  108.           exit;
  109.         end;
  110.  
  111.       NewItem      := Items.AddChild(node, k);
  112.       Newitem.Text := k;
  113.       Newitem.ImageIndex := 1;
  114.       Newitem.SelectedIndex := 1;
  115.  
  116.       if length(l) > 1 then
  117.         add2tree(newitem, l, fullname);
  118.     end;
  119. end;
  120. procedure TCakTreeview.ReloadCAK;
  121. var i : integer;
  122. begin
  123.         items.Clear;
  124.         DirNode := items.Add(nil ,'{Dir View}');
  125.         DirNode.Text := '{DirView}';
  126.         DirNode.ImageIndex := 0;
  127.         DirNode.SelectedIndex := 0;
  128.  
  129.  
  130.         if not assigned(CakDir) then exit;
  131.         if CakDir.DirectoryList.Count = 0 then exit;
  132.         for i := 0 to CakDir.DirectoryList.Count -1 do
  133.                 add2tree(Dirnode, CAKDIr.DirectoryList.strings[i],CAKDIr.DirectoryList.strings[i]);
  134.  
  135.         DirNode.Expand(false);
  136. end;
  137.  
  138. constructor TCakTreeview.Create( AOwner: TComponent );
  139. begin
  140.      inherited Create( AOwner );
  141. end;
  142. destructor TCakTreeview.Destroy;
  143. begin
  144.      inherited Destroy;
  145. end;
  146. procedure Register;
  147. begin
  148.   RegisterComponents('QZip', [TCakTreeView]);
  149. end;
  150.  
  151. end.
  152.