home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 January / Chip_1999-01_cd.bin / zkuste / delphi / D / COMPDOCS.ZIP / ViewMain.pas < prev   
Pascal/Delphi Source File  |  1998-01-05  |  3KB  |  135 lines
  1. unit ViewMain;
  2.  
  3. interface
  4.  
  5. uses
  6.   WinTypes, WinProcs, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   Menus, Grids, Outline, CompDoc;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     MainMenu1 : TMainMenu;
  12.     Open : TOpenDialog;
  13.     File1 : TMenuItem;
  14.     Open1 : TMenuItem;
  15.     Exit1 : TMenuItem;
  16.     Outline : TOutline;
  17.     View1: TMenuItem;
  18.     Expand1: TMenuItem;
  19.     Collapse1: TMenuItem;
  20.     procedure Exit1Click(Sender : TObject);
  21.     procedure Open1Click(Sender : TObject);
  22.     procedure Expand1Click(Sender: TObject);
  23.     procedure Collapse1Click(Sender: TObject);
  24.   private
  25.     { Private declarations }
  26.   public
  27.     { Public declarations }
  28.     procedure ExpandNode(Index : integer; S : TStorage);
  29.   end;
  30.  
  31. var
  32.   Form1 : TForm1;
  33.  
  34. implementation
  35.  
  36.  
  37. {$R *.DFM}
  38.  
  39. procedure TForm1.Exit1Click(Sender : TObject);
  40. begin
  41.   Close;
  42. end;
  43.  
  44. procedure TForm1.Open1Click(Sender : TObject);
  45. var
  46.   Name : string;
  47.   Root : TRootStorage;
  48. begin
  49.   if Open.Execute then
  50.   begin
  51.     Name := Open.FileName;
  52.     if (Name <> '') and FileIsCompoundDoc(Name) then
  53.     begin
  54.       Outline.BeginUpdate;
  55.       Outline.Clear;
  56.       Root := TRootStorage.Create(Name, amReadWrite, smExclusive, tmDirect, false);
  57.       try
  58.         Outline.Add(0, Name);
  59.         ExpandNode(1, Root);
  60.       finally
  61.         Root.Free;
  62.       end;
  63.       Outline.EndUpdate;
  64.     end
  65.     else
  66.     begin
  67.       ShowMessage('Not a compound document');
  68.     end;
  69.   end;
  70. end;
  71.  
  72.  
  73. procedure TForm1.ExpandNode(Index : integer; S : TStorage);
  74. var
  75.   storage : TStorage;
  76.   storages : TStringList;
  77.   streams : TStringList;
  78.   n : integer;
  79.   Name : string;
  80. begin
  81.   streams := TStringList.Create;
  82.   try
  83.     S.ListStreams(streams);
  84.     if streams.Count = 0 then
  85.     begin
  86.       { need to add something or the storage will look like a stream }
  87.       Outline.AddChild(Index, 'storage is empty');
  88.     end
  89.     else
  90.     begin
  91.       for n := 1 to streams.Count do
  92.       begin
  93.         Name := streams[n - 1];
  94.         Outline.AddChild(Index, Name)
  95.       end;
  96.     end;
  97.   finally
  98.     streams.Free;
  99.   end;
  100.   inc(index);
  101.   storages := TStringList.Create;
  102.   try
  103.     S.ListStorages(storages);
  104.     begin
  105.       for n := 1 to storages.Count do
  106.       begin
  107.         Name := storages[n - 1];
  108.         storage := TStorage.Create(Name, S, amReadWrite, tmDirect, false);
  109.         try
  110.           Index := Outline.Add(Index, Name);
  111.           { recursive call next }
  112.           ExpandNode(Index, storage);
  113.         finally
  114.           storage.Free;
  115.         end;
  116.       end;
  117.     end;
  118.   finally
  119.     storages.Free;
  120.   end;
  121. end;
  122.  
  123. procedure TForm1.Expand1Click(Sender: TObject);
  124. begin
  125.   Outline.FullExpand;
  126. end;
  127.  
  128. procedure TForm1.Collapse1Click(Sender: TObject);
  129. begin
  130.   Outline.FullCollapse;
  131. end;
  132.  
  133. end.
  134.  
  135.