home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1998 April A / Pcwk4a98.iso / PROGRAM / DELPHI16 / Calmira / Src / SRC / TREE.PAS < prev    next >
Pascal/Delphi Source File  |  1997-02-15  |  24KB  |  836 lines
  1. {**************************************************************************}
  2. {                                                                          }
  3. {    Calmira shell for Microsoft« Windows(TM) 3.1                          }
  4. {    Source Release 1.0                                                    }
  5. {    Copyright (C) 1997  Li-Hsin Huang                                     }
  6. {                                                                          }
  7. {    This program is free software; you can redistribute it and/or modify  }
  8. {    it under the terms of the GNU General Public License as published by  }
  9. {    the Free Software Foundation; either version 2 of the License, or     }
  10. {    (at your option) any later version.                                   }
  11. {                                                                          }
  12. {    This program 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         }
  15. {    GNU General Public License for more details.                          }
  16. {                                                                          }
  17. {    You should have received a copy of the GNU General Public License     }
  18. {    along with this program; if not, write to the Free Software           }
  19. {    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.             }
  20. {                                                                          }
  21. {**************************************************************************}
  22.  
  23. unit Tree;
  24.  
  25. { This form serves two purposes: the global variable Explorer points
  26.   to the "Explorer" window that is used to navigate disks.  An
  27.   extra function called SelectFolder() creates a modal tree dialog
  28.   for the user to pick a directory.
  29.  
  30.   Since Delphi's form inheritance is rather limited, both versions
  31.   of the tree are handled by one class, and the IsModal global
  32.   determines how the object should behave.
  33.  
  34.   Directory outlines
  35.  
  36.   Delphi's sample TDirectoryOutline is pretty hopeless, as most Delphi
  37.   programmers have discovered.  The tree view needs to indicate folders
  38.   which contain sub-folders, but TOutline can't cope with drawing
  39.   plus/minus symbols together with node pictures, and TDirectoryOutline
  40.   doesn't bother to tackle this.
  41.  
  42.   So some custom code is required, which builds each level of the
  43.   tree as the user reaches it, but also checks for sub-folders.
  44.  
  45.  
  46.   Outline drawing
  47.  
  48.   The main feature of the tree view is the that way it owner-draws the
  49.   TOutline control.  The default TOutline painting method uses BrushCopy(),
  50.   which provides bitmap transparency but is extremely slow.  The tree
  51.   view just uses Draw(), which makes it very fast, but this means that
  52.   selected items can only be focused and not highlighted.
  53.  
  54.   Another problem is that level 1 nodes (i.e. disk drives) need to have
  55.   descriptive captions, but this makes it harder to obtain the
  56.   selected folder using the FullPath property.  The solution is to store
  57.   the descriptive captions in a separate TStringList which is accessed
  58.   during drawing.
  59. }
  60.  
  61.  
  62. interface
  63.  
  64. uses
  65.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  66.   Forms, Dialogs, Grids, Outline, StdCtrls, IconWin, FileCtrl, Menus,
  67.   ExtCtrls, CalForm, FormDrag, Settings, Scrtree, CalMsgs, Sysmenu;
  68.  
  69. type
  70.   TExplorer = class(TCalForm)
  71.     PopupMenu: TPopupMenu;
  72.     OpenFolder: TMenuItem;
  73.     OpenNew: TMenuItem;
  74.     RefreshTree: TMenuItem;
  75.     N2: TMenuItem;
  76.     ExpandLevel: TMenuItem;
  77.     ExpandBranch: TMenuItem;
  78.     ExpandAll: TMenuItem;
  79.     CollapseBranch: TMenuItem;
  80.     N1: TMenuItem;
  81.     FileWindow: TMenuItem;
  82.     Dragger: TFormDrag;
  83.     Outline: TScrollTree;
  84.     SystemMenu: TSystemMenu;
  85.     procedure FormCreate(Sender: TObject);
  86.     procedure OutlineDrawItem(Control: TWinControl; Index: Integer;
  87.       Rect: TRect; State: TOwnerDrawState);
  88.     procedure FormResize(Sender: TObject);
  89.     procedure OpenFolderClick(Sender: TObject);
  90.     procedure OpenNewClick(Sender: TObject);
  91.     procedure ExpandLevelClick(Sender: TObject);
  92.     procedure ExpandBranchClick(Sender: TObject);
  93.     procedure ExpandAllClick(Sender: TObject);
  94.     procedure CollapseBranchClick(Sender: TObject);
  95.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  96.     procedure OutlineMouseDown(Sender: TObject; Button: TMouseButton;
  97.       Shift: TShiftState; X, Y: Integer);
  98.     procedure OutlineClick(Sender: TObject);
  99.     procedure FormDestroy(Sender: TObject);
  100.     procedure RefreshTreeClick(Sender: TObject);
  101.     procedure OutlineExpand(Sender: TObject; Index: Longint);
  102.     procedure FileWindowClick(Sender: TObject);
  103.     procedure FormHide(Sender: TObject);
  104.     procedure FormShow(Sender: TObject);
  105.     procedure FormPaint(Sender: TObject);
  106.     procedure OutlineKeyDown(Sender: TObject; var Key: Word;
  107.       Shift: TShiftState);
  108.     procedure OutlineDragOver(Sender, Source: TObject; X, Y: Integer;
  109.       State: TDragState; var Accept: Boolean);
  110.     procedure OutlineDragDrop(Sender, Source: TObject; X, Y: Integer);
  111.     procedure OutlineMouseUp(Sender: TObject; Button: TMouseButton;
  112.       Shift: TShiftState; X, Y: Integer);
  113.   private
  114.     { Private declarations }
  115.     FilePane : TIconWindow;
  116.     PreventClick : Boolean;
  117.     Walking: Boolean;
  118.     DriveCaptions : TStringList;
  119.     BmpList : TBitmap;
  120.     procedure AlignFilePane;
  121.   protected
  122.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  123.     procedure ExpandFolder(Index: Longint);
  124.     procedure Walktree(Index: Longint);
  125.     {function ExpandToNode(const Dir: string): Longint;}
  126.     function FindDirectory(const Dir: string; ExpandPath: Boolean): Longint;
  127.   public
  128.     { Public declarations }
  129.     function SelectedFolder : TFilename;
  130.     procedure BuildTree;
  131.     procedure Configure;
  132.     procedure Travel(const folder: TFilename);
  133.     procedure SettingsChanged(Changes : TSettingChanges); override;
  134.   end;
  135.  
  136. procedure OpenExplorer(const default : TFilename);
  137. function SelectFolder(const default : TFilename): TFilename;
  138.  
  139.  
  140. var
  141.   Explorer: TExplorer;
  142.   IsModal : Boolean;
  143.  
  144. implementation
  145.  
  146. {$R *.DFM}
  147.  
  148. uses Strings, Desk, MiscUtil, Files, Resource, Sys, Iconic,
  149.   Drives, MultiGrd, Referenc;
  150.  
  151. const
  152.   { TOutlineNode's Data property is used to store flags, which speeds
  153.     up drawing by avoiding the call to GetLastChild by marking the last
  154.     child node.  The HasChildren flag determines if subdirectories
  155.     exist. }
  156.  
  157.   IsLastChild = 1;
  158.   HasChildren = 2;
  159.  
  160.  
  161. function ExtractNodeDir(const s: TFilename): TFilename;
  162. var p: Integer;
  163. begin
  164.   { Returns the name of a folder, given an outline node's FullPath,
  165.     which looks something like
  166.  
  167.     System\c:\\delphi\projects
  168.  
  169.     The first Delete() call chops off 'System\' and the second
  170.     removes the extra '\'.  This should leave a valid folder.
  171.   }
  172.  
  173.   Result := s;
  174.   p := Pos('\', Result);
  175.   if p > 0 then System.Delete(Result, 1, p);
  176.   p := Pos('\\', Result);
  177.   if p > 0 then System.Delete(Result, p, 1);
  178. end;
  179.  
  180.  
  181. procedure TExplorer.BuildTree;
  182. var
  183.   root : string[3];
  184.   i: Integer;
  185.   Last : Longint;
  186.   Letter : Char;
  187.   DriveType : TDriveType;
  188.   title : string[63];
  189.   node : TOutlineNode;
  190. begin
  191.   { Constructs the 1st two levels of the outline.
  192.  
  193.     Fixed drives are searched for a volume label and removeable drives
  194.     are just indicated as such.  Each title is added to the DriveCaptions
  195.     list. }
  196.  
  197.   DriveCaptions.Clear;
  198.   Outline.Clear;
  199.   Outline.AddChild(0, SysWindow.Caption);
  200.   Last := 0;
  201.  
  202.   for Letter := 'A' to 'Z' do begin
  203.     DriveType := GuessDriveType(Letter);
  204.     if DriveType <> dtNoDrive then begin
  205.       Last := Outline.AddChild(1, LowCase(Letter) + ':\');
  206.       node := Outline.Items[Last];
  207.       case DriveType of
  208.         dtFloppy,
  209.         dtCDROM  : title := '';
  210.         dtFixed,
  211.         dtNetwork: title := GetNetworkVolume(Letter);
  212.         dtRAM    : title := GetVolumeID(Letter);
  213.       end;
  214.       if title = '' then title := MakeDriveName(DriveType, Letter)
  215.       else title := Format('%s (%s:)', [Uppercase(title), Letter]);
  216.       DriveCaptions.AddObject(title, node);
  217.     end;
  218.   end;
  219.  
  220.   if Last > 0 then Outline.Items[Last].Data := Pointer(IsLastChild);
  221.  
  222.   Outline.Items[1].Expand;
  223. end;
  224.  
  225.  
  226. procedure TExplorer.FormCreate(Sender: TObject);
  227. begin
  228.   with SystemMenu do begin
  229.     DeleteCommand(SC_SIZE);
  230.     DeleteCommand(SC_MAXIMIZE);
  231.   end;
  232.  
  233.   BmpList := TResBitmap.Load('TREEBMPS');
  234.   DriveCaptions := TStringList.Create;
  235.   Icon.Assign(Icons.Get('Explorer'));
  236.   Configure;
  237.  
  238.   if IsModal then begin
  239.     OpenNew.Enabled := False;
  240.     FileWindow.Enabled := False;
  241.     BorderIcons := BorderIcons - [biMinimize];
  242.   end
  243.   else begin
  244.     LoadPosition(ini, 'Explorer');
  245.     FileWindow.Checked := ini.ReadBool('Explorer', 'FileWindow', False);
  246.   end;
  247.  
  248.   BuildTree;
  249. end;
  250.  
  251.  
  252. procedure TExplorer.Configure;
  253. begin
  254.   Color := Colors[ccWinFrame];
  255.   with Outline do begin
  256.     Font.Assign(GlobalFont);
  257.     Canvas.Font.Assign(Font);
  258.     Canvas.Pen.Color := clTeal;
  259.     ItemHeight := LineHeight;
  260.     ThumbTracking := TrackThumb;
  261.   end;
  262.   Dragger.Hollow := HollowDrag;
  263. end;
  264.  
  265.  
  266. procedure TExplorer.OutlineDrawItem(Control: TWinControl; Index: Integer;
  267.   Rect: TRect; State: TOwnerDrawState);
  268. var
  269.   item: TOutlineNode;
  270.   x, y, L : Integer;
  271. begin
  272.   with Outline do begin
  273.     { TOutline [mistakenly?] passes the graphical row as the Index
  274.       rather than the index of the outline item, so we must convert
  275.       it back. }
  276.  
  277.     Index := GetItem(0, Rect.Top);
  278.     item := Items[index];
  279.     L := item.Level;
  280.     x := Rect.Left + (L-1) * 20 + 4;
  281.     y := (Rect.Top + Rect.Bottom) div 2;
  282.  
  283.     with Canvas do begin
  284.       FillRect(Rect);
  285.  
  286.       { index = 1   the system 'icon' is drawn
  287.         level = 2   the drive type is used to offset into the bitmap list
  288.         else        an open or closed folder is drawn }
  289.  
  290.       if index = 1 then
  291.         CopyRect(Bounds(x, Rect.Top, 16, 16), BmpList.Canvas,
  292.           Bounds(0, 0, 16, 16))
  293.  
  294.       else if L = 2 then
  295.         CopyRect(Bounds(x, Rect.Top, 16, 16), BmpList.Canvas,
  296.           Bounds(Succ(Ord(GuessDriveType(item.Text[1]))) * 16, 0, 16, 16))
  297.  
  298.       else if item.HasItems and item.Expanded then
  299.         Draw(x, Rect.Top+2, PictureOpen)
  300.       else
  301.         Draw(x, Rect.Top+2, PictureClosed);
  302.  
  303.       { items on level 2 are disk drives, which have their captions
  304.         stored in the string list }
  305.  
  306.       if L = 2 then
  307.         TextOut(x + 19, Rect.Top+1, DriveCaptions[DriveCaptions.IndexOfObject(item)])
  308.       else
  309.         TextOut(x + 19, Rect.Top+1, item.Text);
  310.  
  311.       if index = 1 then exit;
  312.  
  313.       { Draw the horizontal line connecting the node }
  314.       MoveTo(x - 4, y);
  315.       Dec(x, 16);
  316.       LineTo(x, y);
  317.  
  318.       { If the node is the last child, don't extend the vertical
  319.         line any further than the middle }
  320.  
  321.       if Longint(item.Data) and IsLastChild > 0 then
  322.         LineTo(x, Rect.Top-1)
  323.       else begin
  324.         MoveTo(x, Rect.Top);
  325.         LineTo(x, Rect.Bottom);
  326.       end;
  327.  
  328.       { Draw a suitable plus/minus picture depending on if
  329.         there are subfolders }
  330.  
  331.       if Longint(item.Data) and HasChildren > 0 then
  332.         if item.Expanded then Draw(x - 4, y - 4, PictureMinus)
  333.         else Draw(x - 4, y - 4, PicturePlus);
  334.  
  335.       { Draw the vertical lines to the left of the node's bitmap,
  336.         by moving up through the parent nodes.  If a parent node
  337.         is a "last child", then don't draw a line (because there
  338.         are no siblings underneath it) }
  339.  
  340.       Dec(x, 20);
  341.       while x > 0 do begin
  342.         item := item.Parent;
  343.         if not Longint(item.Data) and IsLastChild > 0 then begin
  344.           MoveTo(x, Rect.Top);
  345.           LineTo(x, Rect.Bottom);
  346.         end;
  347.         Dec(x, 20);
  348.       end;
  349.  
  350.     end;
  351.   end;
  352. end;
  353.  
  354.  
  355. function TExplorer.SelectedFolder : TFilename;
  356. var p: Integer;
  357. begin
  358.   with Outline do
  359.     if SelectedItem = 1 then Result := ''
  360.     else Result := ExtractNodeDir(Items[SelectedItem].FullPath);
  361. end;
  362.  
  363.  
  364. procedure TExplorer.Notification(AComponent: TComponent; Operation: TOperation);
  365. begin
  366.   { The tree view must be kept informed if it's slave icon window
  367.     has been destroyed }
  368.   inherited Notification(AComponent, Operation);
  369.   if (AComponent = FilePane) and (Operation = opRemove) then FilePane := nil;
  370. end;
  371.  
  372.  
  373. procedure TExplorer.FormResize(Sender: TObject);
  374. begin
  375.   Outline.Width := ClientWidth - 8;
  376.   Outline.Height := ClientHeight - Outline.Top - 4;
  377.   Invalidate;
  378. end;
  379.  
  380.  
  381. procedure TExplorer.AlignFilePane;
  382. var
  383.   w: Integer;
  384. begin
  385.   if FilePane = nil then Exit;
  386.   FilePane.WindowState := wsNormal;
  387.  
  388.   { SetWindowPos conveniently repositions windows without activating them }
  389.  
  390.   if FileWindow.Checked and TreeAlign then begin
  391.     if FilePane.Visible then w := FilePane.Width
  392.     else w := FilePane.CalcSize(FilePaneCols, 4).X;
  393.  
  394.     SetWindowPos(FilePane.Handle, Handle, Left + Width - 1, Top,
  395.       w, Height, SWP_NOACTIVATE)
  396.   end
  397.   else
  398.     SetWindowPos(FilePane.Handle, Handle, 0, 0, 0, 0,
  399.       SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE);
  400. end;
  401.  
  402.  
  403. procedure TExplorer.OpenFolderClick(Sender: TObject);
  404. var
  405.   s: TFilename;
  406.   w: TIconWindow;
  407. begin
  408.   { A modal tree dialog returns immediately after a folder is
  409.     "opened" or Enter is pressed }
  410.  
  411.   if IsModal then begin
  412.     if Outline.SelectedItem > 1 then ModalResult := mrOK;
  413.     Exit;
  414.   end;
  415.  
  416.   if Outline.SelectedItem = 1 then SysWindow.ShowNormal
  417.   else begin
  418.     s := SelectedFolder;
  419.     w := Desktop.WindowOf(s);
  420.  
  421.     if (w <> nil) and (w <> FilePane) then w.Free;
  422.  
  423.     if (FilePane <> nil) and (FilePane.Caption <> s) then begin
  424.       FilePane.ChangeDir(s);
  425.       AlignFilePane;
  426.     end
  427.     else
  428.       OpenNew.Click;
  429.   end;
  430. end;
  431.  
  432.  
  433. procedure TExplorer.OpenNewClick(Sender: TObject);
  434. var s: TFilename;
  435. begin
  436.   if IsModal then Exit;
  437.  
  438.   if Outline.SelectedItem = 1 then SysWindow.ShowNormal
  439.   else begin
  440.     if FilePane <> nil then FilePane.Locked := False;
  441.     s := SelectedFolder;
  442.     FilePane := Desktop.WindowOf(s);
  443.  
  444.     if FilePane = nil then
  445.       FilePane := TIconWindow.Init(Application, s, DefaultFilter);
  446.  
  447.     { SetWindowPos can "resize" an iconic window which results in a strange
  448.       overlapping effect.  To prevent this, only use it on windows which
  449.       have been restored }
  450.  
  451.     FilePane.Locked := True;
  452.     AlignFilePane;
  453.     FilePane.Visible := True;
  454.   end;
  455. end;
  456.  
  457.  
  458. procedure TExplorer.ExpandLevelClick(Sender: TObject);
  459. var item : TOutlineNode;
  460. begin
  461.   with Outline do begin
  462.     item := Items[SelectedItem];
  463.     if not item.HasItems and (Longint(item.Data) and HasChildren > 0) then
  464.       ExpandFolder(SelectedItem);
  465.     item.Expand;
  466.   end;
  467. end;
  468.  
  469.  
  470. procedure TExplorer.ExpandBranchClick(Sender: TObject);
  471. begin
  472.   Desktop.SetCursor(crHourGlass);
  473.   Update;
  474.   Walking := True;
  475.   try
  476.     with Outline do begin
  477.       WalkTree(SelectedItem);
  478.       Items[SelectedItem].FullExpand;
  479.     end;
  480.   finally
  481.     Desktop.ReleaseCursor;
  482.     Walking := False;
  483.   end;
  484. end;
  485.  
  486.  
  487. procedure TExplorer.ExpandAllClick(Sender: TObject);
  488. begin
  489.   Desktop.SetCursor(crHourGlass);
  490.   Outline.Hide;
  491.   Walking := True;
  492.   try
  493.     WalkTree(1);
  494.     Outline.FullExpand;
  495.   finally
  496.     Outline.Show;
  497.     Desktop.ReleaseCursor;
  498.     Walking := False;
  499.   end;
  500. end;
  501.  
  502.  
  503. procedure TExplorer.CollapseBranchClick(Sender: TObject);
  504. begin
  505.   with Outline do Items[SelectedItem].Collapse;
  506. end;
  507.  
  508.  
  509. procedure TExplorer.FormClose(Sender: TObject; var Action: TCloseAction);
  510. begin
  511.   if IsModal then Action := caHide
  512.   else begin
  513.     Action := caFree;
  514.     if FilePane <> nil then FilePane.Locked := False;
  515.   end;
  516. end;
  517.  
  518.  
  519. procedure TExplorer.OutlineMouseDown(Sender: TObject; Button: TMouseButton;
  520.   Shift: TShiftState; X, Y: Integer);
  521. var
  522.   i: Integer;
  523.   p: TPoint;
  524. begin
  525.   if Button = mbRight then with Outline do begin
  526.     PreventClick := True;
  527.     i := GetItem(X, Y);
  528.     if i > 0 then begin
  529.       SelectedItem := i;
  530.       GetCursorPos(p);
  531.       PopupMenu.Popup(p.X, p.Y);
  532.     end;
  533.   end;
  534. end;
  535.  
  536. procedure TExplorer.OutlineClick(Sender: TObject);
  537. begin
  538.   if FileWindow.Checked and
  539.     not (PreventClick or Walking or IsModal) then OpenFolder.Click;
  540.   PreventClick := False;
  541. end;
  542.  
  543.  
  544. procedure TExplorer.FormDestroy(Sender: TObject);
  545. begin
  546.   if not IsModal then begin
  547.     SavePosition(ini, 'Explorer');
  548.     ini.WriteBool('Explorer', 'FileWindow', FileWindow.Checked);
  549.     Explorer := nil;
  550.   end;
  551.  
  552.   DriveCaptions.Free;
  553.   BmpList.Free;
  554. end;
  555.  
  556.  
  557. procedure TExplorer.RefreshTreeClick(Sender: TObject);
  558. var
  559.   last : TFilename;
  560.   i: Longint;
  561. begin
  562.   last := SelectedFolder;
  563.   BuildTree;
  564.   if last > '' then Travel(last);
  565. end;
  566.  
  567.  
  568. procedure TExplorer.Travel(const folder: TFilename);
  569. var i: Longint;
  570. begin
  571.   Walking := True;
  572.   try
  573.     i := 0;
  574.     if HDirectoryExists(folder) then i := FindDirectory(folder, True);
  575.   finally
  576.     Walking := False;
  577.   end;
  578.  
  579.   if i > 0 then begin
  580.     PreventClick := True;
  581.     Outline.SelectedItem := i;
  582.   end;
  583. end;
  584.  
  585.  
  586. procedure TExplorer.OutlineExpand(Sender: TObject; Index: Longint);
  587. var
  588.   node : TOutlineNode;
  589. begin
  590.   node := Outline.Items[Index];
  591.  
  592.     if not node.HasItems and
  593.        ((Longint(node.Data) and HasChildren > 0) or (node.Level = 2)) then begin
  594.        ExpandFolder(Index);
  595.        if not node.HasItems then node.Expanded := False;
  596.     end;
  597. end;
  598.  
  599.  
  600.  
  601. function TExplorer.FindDirectory(const Dir: string; ExpandPath : Boolean): Longint;
  602. var
  603.   start: Longint;
  604.   node : TOutlineNode;
  605.   this : string[12];
  606. begin
  607.   { FindDirectory locates an outline node by recursing until the top level
  608.     folder is extracted.  Then it unrolls, searching for directory names
  609.     as it returns, while expanding the nodes it passes through }
  610.  
  611.   if Length(Dir) = 3 then begin
  612.     Result := Outline.GetTextItem(Dir);
  613.     if (Result > 0) and ExpandPath then Outline.Items[Result].Expand;
  614.   end
  615.   else begin
  616.     Result := 0;
  617.     this := ExtractFilename(Dir);
  618.     if (this = '') or (Length(this) = Length(Dir)) then Exit;
  619.     start := FindDirectory(ExtractFileDir(Dir), ExpandPath);
  620.     if start > 0 then begin
  621.       node := Outline.Items[start];
  622.       Result := node.GetFirstChild;
  623.       while Result <> -1 do
  624.         if Outline.Items[Result].Text = this then begin
  625.           if ExpandPath then Outline.Items[Result].Expand;
  626.           Exit;
  627.         end
  628.         else Result := node.GetNextChild(Result);
  629.     end;
  630.   end;
  631. end;
  632.  
  633.  
  634.  
  635. procedure TExplorer.Walktree(Index: Longint);
  636. var
  637.   i: Longint;
  638.   p: TOutlineNode;
  639. begin
  640.   { Expands a branch of the tree beginning at Index.  This is not the
  641.     same as FullExpand because this expansion causes new nodes to be
  642.     added when directories are found }
  643.  
  644.   p := Outline.Items[Index];
  645.   p.Expand;
  646.   i := p.GetFirstChild;
  647.   while i <> -1 do begin
  648.     if Longint(Outline.Items[i].Data) and HasChildren > 0 then WalkTree(i);
  649.     i := p.GetNextChild(i);
  650.     if KeyBreak and (GetAsyncKeyState(VK_ESCAPE) < 0) then Abort;
  651.   end;
  652. end;
  653.  
  654.  
  655. function HasSubDirectories(const Dirname: string): Boolean;
  656. var
  657.   rec : TSearchRec;
  658.   code : Integer;
  659. begin
  660.   code := FindFirst(Dirname + '\*.*', faDirectory or faHidden, rec);
  661.   while code = 0 do
  662.     if (rec.attr and faDirectory <> 0) and (rec.name[1] <> '.') then Break
  663.     else code := FindNext(rec);
  664.  
  665.   Result := code = 0;
  666. end;
  667.  
  668.  
  669. procedure TExplorer.ExpandFolder(Index: Longint);
  670. var
  671.   rec : TSearchRec;
  672.   path : TFilename;
  673.   last : Longint;
  674.   par, item : TOutlineNode;
  675.   code, i : Integer;
  676.   sortlist : TStringList;
  677. begin
  678.   last := -1;
  679.   par := Outline.Items[Index];
  680.   path := MakePath(ExtractNodeDir(par.FullPath));
  681.   sortlist := TUniqueStrings.Create;
  682.  
  683.   try
  684.  
  685.   code := FindFirst(path + '*.*', faDirectory or faHidden, rec);
  686.  
  687.   if code = -3 then
  688.     MsgDialog('Cannot open ' + MakeDirname(path), mtError, [mbOK], 0);
  689.  
  690.   while code = 0 do begin
  691.     if (rec.attr and faDirectory <> 0) and (rec.name[1] <> '.') then
  692.       if HasSubDirectories(path + rec.name) then
  693.         sortlist.AddObject(Lowercase(rec.name), Pointer(HasChildren))
  694.       else
  695.         sortlist.Add(Lowercase(rec.name));
  696.     if KeyBreak and (GetAsyncKeyState(VK_ESCAPE) < 0) then Break;
  697.     code := FindNext(rec);
  698.   end;
  699.  
  700.   with sortlist do
  701.     if Count > 0 then begin
  702.       for i := 0 to Count-1 do
  703.         last := Outline.AddChildObject(Index, Strings[i], Objects[i]);
  704.  
  705.       item := Outline.Items[last];
  706.       item.Data := Pointer(IsLastChild or Longint(item.Data));
  707.       par.Data := Pointer(HasChildren or Longint(par.Data));
  708.     end;
  709.  
  710.   finally
  711.     sortlist.Free;
  712.   end;
  713. end;
  714.  
  715.  
  716. procedure OpenExplorer(const default : TFilename);
  717. begin
  718.   if Explorer = nil then Explorer := TExplorer.Create(Application);
  719.   Explorer.Travel(default);
  720.   Explorer.ShowNormal;
  721. end;
  722.  
  723.  
  724. procedure TExplorer.FileWindowClick(Sender: TObject);
  725. begin
  726.   FileWindow.Checked := not FileWindow.Checked;
  727. end;
  728.  
  729.  
  730. procedure TExplorer.FormHide(Sender: TObject);
  731. begin
  732.   if not IsModal and ExplorerTask then
  733.     PostMessage(TaskbarWindow, WM_CALMIRA, CM_DELCALWINDOW, Handle);
  734. end;
  735.  
  736.  
  737. procedure TExplorer.FormShow(Sender: TObject);
  738. begin
  739.   if not IsModal and ExplorerTask then
  740.     PostMessage(TaskbarWindow, WM_CALMIRA, CM_ADDCALWINDOW, Handle);
  741. end;
  742.  
  743.  
  744. procedure TExplorer.FormPaint(Sender: TObject);
  745. begin
  746.   Border3D(Canvas, ClientWidth-1, ClientHeight-1);
  747. end;
  748.  
  749.  
  750. function SelectFolder(const default: TFilename) : TFilename;
  751. begin
  752.   IsModal := True;
  753.   try
  754.     with TExplorer.Create(Application) do begin
  755.       Position := poScreenCenter;
  756.       Caption := 'Select folder';
  757.       Travel(default);
  758.       try
  759.         Result := '';
  760.         if ShowModal = mrOK then Result := SelectedFolder
  761.         else Result := default;
  762.       finally
  763.         Free;
  764.       end;
  765.     end;
  766.   finally
  767.      IsModal := False;
  768.   end;
  769. end;
  770.  
  771.  
  772. procedure TExplorer.OutlineKeyDown(Sender: TObject; var Key: Word;
  773.   Shift: TShiftState);
  774. begin
  775.   if IsModal and (Key = VK_ESCAPE) then ModalResult := mrCancel;
  776. end;
  777.  
  778.  
  779.  
  780. procedure TExplorer.OutlineDragOver(Sender, Source: TObject; X, Y: Integer;
  781.   State: TDragState; var Accept: Boolean);
  782. begin
  783.   Accept := (Source is TMultiGrid) and (Source <> SysWindow.Grid)
  784.     and (Outline.GetItemAt(X, Y) > 1);
  785.  
  786.   with Outline do
  787.     if not Accept or (State = dsDragLeave) then DropFocus := -1
  788.     else DropFocus := GetCellAt(X, Y);
  789. end;
  790.  
  791.  
  792. procedure TExplorer.OutlineDragDrop(Sender, Source: TObject; X,
  793.   Y: Integer);
  794. begin
  795.   with Outline do begin
  796.     DropFocus := -1;
  797.     FolderRef.Target := ExtractNodeDir(Items[GetItemAt(X, Y)].FullPath);
  798.   end;
  799.   FolderRef.DragDrop(Source);
  800. end;
  801.  
  802.  
  803. procedure TExplorer.SettingsChanged(Changes : TSettingChanges);
  804. begin
  805.   if [scSystem, scDisplay, scDesktop] * Changes <> [] then
  806.     Configure;
  807.   if scDevices in Changes then RefreshTree.Click;
  808. end;
  809.  
  810.  
  811. procedure TExplorer.OutlineMouseUp(Sender: TObject; Button: TMouseButton;
  812.   Shift: TShiftState; X, Y: Integer);
  813. var
  814.   junction : Integer;
  815.   item : Longint;
  816.   node : TOutlineNode;
  817. begin
  818.   if (Button = mbLeft) and not (ssDouble in Shift) then with Outline do begin
  819.     { Test if the user clicked on + or - box }
  820.     item := GetItemAt(X, Y);
  821.     if item > 0 then begin
  822.       node := Items[item];
  823.       if Longint(node.Data) and HasChildren > 0 then begin
  824.         junction := (node.Level-1) * 20 - 12;
  825.         if (X > junction - 6) and (X < junction + 6) then begin
  826.           SelectedItem := item;
  827.           with node do Expanded := not Expanded;
  828.         end;
  829.       end;
  830.     end;
  831.   end
  832. end;
  833.  
  834.  
  835. end.
  836.