home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1998 April A / Pcwk4a98.iso / PROGRAM / DELPHI16 / Calmira / Src / SRC / ICONWIN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-02-17  |  41.4 KB  |  1,473 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 IconWin;
  24.  
  25. { Icon Windows unit.
  26.  
  27.   Fields
  28.  
  29.     FDir - the form's TDirectory object that holds a list of files and folders.
  30.  
  31.     SelSize - the size (in bytes) of all items selected
  32.  
  33.     FDragCopy - True if the current drag-and-drop should copy files if
  34.       successful, False if the operation is a move.
  35.  
  36.     FSelected - the focused TDirItem
  37.  
  38.     FSelection - contains a list of selected TDirItems, but is only valid
  39.       immediately after CompileSelection is called.
  40.  
  41.     FLocked - boolean that indicates if the form should not change its
  42.       size automatically, probably due to the tree view being attached.
  43.  
  44.     DragJustEnded - flag that is set after OnDragEnd to stop deselections
  45.  
  46.     Stretching - true if the user is using the lasso to make a selection
  47. }
  48.  
  49. interface
  50.  
  51. uses
  52.   SysUtils, WinTypes, Classes, Controls, Forms, Dialogs, StdCtrls, ExtCtrls,
  53.   Directry, Menus, MultiGrd, Dropclnt, DropServ, DragDrop, Settings,
  54.   Grids, Messages, Progress, Resource, CalForm, FormDrag, CalMsgs;
  55.  
  56. type
  57.   TIconWindow = class(TCalForm)
  58.     TotalLabel: TLabel;
  59.     SelLabel: TLabel;
  60.     ObjectMenu: TPopupMenu;
  61.     Open: TMenuItem;
  62.     OpenWith: TMenuItem;
  63.     Delete: TMenuItem;
  64.     Properties: TMenuItem;
  65.     Rename: TMenuItem;
  66.     CreateAlias: TMenuItem;
  67.     Duplicate: TMenuItem;
  68.     Grid: TMultiGrid;
  69.     DropServer: TDropServer;
  70.     DropClient: TDropClient;
  71.     WinMenu: TPopupMenu;
  72.     CreateFolder: TMenuItem;
  73.     Undelete: TMenuItem;
  74.     Run: TMenuItem;
  75.     N1: TMenuItem;
  76.     SetFilter: TMenuItem;
  77.     SortbyType: TMenuItem;
  78.     SortbyName: TMenuItem;
  79.     SortbySize: TMenuItem;
  80.     SortbyDate: TMenuItem;
  81.     N2: TMenuItem;
  82.     Inspect: TMenuItem;
  83.     ViewList: TMenuItem;
  84.     AliasProp: TMenuItem;
  85.     Describe: TMenuItem;
  86.     Dragger: TFormDrag;
  87.     FileSystem: TMenuItem;
  88.     Select: TMenuItem;
  89.     procedure FormCreate(Sender: TObject);
  90.     procedure FormDestroy(Sender: TObject);
  91.     procedure FormResize(Sender: TObject);
  92.     procedure FormPaint(Sender: TObject);
  93.     procedure GridDragOver(Sender, Source: TObject; X, Y: Integer;
  94.      State: TDragState; var Accept: Boolean);
  95.     procedure GridDragDrop(Sender, Source: TObject; X, Y: Integer);
  96.     procedure ObjectMenuPopup(Sender: TObject);
  97.     procedure OpenClick(Sender: TObject);
  98.     procedure DeleteClick(Sender: TObject);
  99.     procedure CreateFolderClick(Sender: TObject);
  100.     procedure GridMouseDown(Sender: TObject; Button: TMouseButton;
  101.      Shift: TShiftState; X, Y: Integer);
  102.     procedure FormDragOver(Sender, Source: TObject; X, Y: Integer;
  103.      State: TDragState; var Accept: Boolean);
  104.     procedure OpenWithClick(Sender: TObject);
  105.     procedure PropertiesClick(Sender: TObject);
  106.     procedure GridCellSelected(Sender: TObject; Index : Integer; IsSelected: Boolean);
  107.     procedure RenameClick(Sender: TObject);
  108.     procedure GridKeyPress(Sender: TObject; var Key: Char);
  109.     procedure FormDragDrop(Sender, Source: TObject; X, Y: Integer);
  110.     procedure RunClick(Sender: TObject);
  111.     procedure CreateAliasClick(Sender: TObject);
  112.     procedure SetFilterClick(Sender: TObject);
  113.     procedure SortByTypeClick(Sender: TObject);
  114.     procedure UndeleteClick(Sender: TObject);
  115.     procedure GridKeyDown(Sender: TObject; var Key: Word;
  116.       Shift: TShiftState);
  117.     procedure FormShow(Sender: TObject);
  118.     procedure DuplicateClick(Sender: TObject);
  119.     procedure GridDrawCell(Sender: TObject; Index: Integer;
  120.       Rect: TRect; State: TGridDrawState);
  121.     procedure GridSelectCell(Sender: TObject; Index: Integer;
  122.       var CanSelect: Boolean);
  123.     procedure DropServerFileDrop(Sender: TObject; X, Y: Integer;
  124.       Target: Word);
  125.     procedure TotalLabelMouseDown(Sender: TObject; Button: TMouseButton;
  126.       Shift: TShiftState; X, Y: Integer);
  127.     procedure GridMouseUp(Sender: TObject; Button: TMouseButton;
  128.       Shift: TShiftState; X, Y: Integer);
  129.     procedure GridEndDrag(Sender, Target: TObject; X, Y: Integer);
  130.     procedure SelLabelMouseDown(Sender: TObject; Button: TMouseButton;
  131.       Shift: TShiftState; X, Y: Integer);
  132.     procedure GridMouseMove(Sender: TObject; Shift: TShiftState; X,
  133.       Y: Integer);
  134.     procedure DropClientDropFiles(Sender: TObject);
  135.     procedure DropServerDeskDrop(Sender: TObject; X, Y: Integer;
  136.       Target: Word);
  137.     procedure FormDblClick(Sender: TObject);
  138.     procedure GridSelect(Sender: TObject; Index: Integer);
  139.     procedure InspectClick(Sender: TObject);
  140.     procedure ViewListClick(Sender: TObject);
  141.     procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
  142.       Shift: TShiftState; X, Y: Integer);
  143.     procedure TotalLabelClick(Sender: TObject);
  144.     procedure AliasPropClick(Sender: TObject);
  145.     procedure FormHide(Sender: TObject);
  146.     procedure DescribeClick(Sender: TObject);
  147.     procedure FileSystemClick(Sender: TObject);
  148.     procedure SelectClick(Sender: TObject);
  149.     procedure WinMenuPopup(Sender: TObject);
  150.     procedure GridDblClick(Sender: TObject);
  151.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  152.   private
  153.     { Private declarations }
  154.     FDir : TDirectory;
  155.     Selsize : Longint;
  156.     FDragCopy : Boolean;
  157.     FSelected : TDirItem;
  158.     FSelection: TFileList;
  159.     FLocked : Boolean;
  160.     DragJustEnded: Boolean;
  161.     Stretching: Boolean;
  162.     Corner, Anchor: TPoint;
  163.     procedure Arrange(Sender : TObject);
  164.     procedure InitFileOp(Op : TFileOperation);
  165.     procedure DoneFileOp;
  166.     function InitCopy(const dest: string) : Boolean;
  167.     function InitMove(const dest: string) : Boolean;
  168.     function InitDelete(const dest: string) : Boolean;
  169.     procedure AutoResize;
  170.     procedure ConstructPathMenu;
  171.     procedure SetDragCopy(copy: Boolean);
  172.     procedure GridDrawList(Sender: TObject; Index: Integer;
  173.       Rect: TRect; State: TGridDrawState);
  174.     procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND;
  175.     procedure WMNCRButtonDown(var Msg: TWMNCRButtonDown); message WM_NCRBUTTONDOWN;
  176.     procedure WMActivate(var Msg : TWMActivate); message WM_ACTIVATE;
  177.     procedure DrawLasso(r: TRect);
  178.     procedure SelectFileHandler(Sender : TObject;
  179.       const FileSpec : string; select : Boolean);
  180.   protected
  181.     { Protected declarations }
  182.   public
  183.     { Public declarations }
  184.     constructor Init(AOwner: TComponent;
  185.       const foldername, filter: TFilename);
  186.     procedure DropInFolder(const foldername: TFilename);
  187.     procedure DropInWindow(d : TDirectory);
  188.     procedure FolderRenamed(const previous, current: TFilename);
  189.     function FileAt(x, y : Integer; wholecell: Boolean) : TDirItem;
  190.     function CompileSelection(recurse: Boolean): TFileList;
  191.     function CompileFilenames: TStringList;
  192.     procedure ChangeDir(const foldername : string);
  193.     function LoadDimensions: Boolean;
  194.     procedure SaveDimensions;
  195.     procedure Configure;
  196.     procedure SettingsChanged(Changes : TSettingChanges); override;
  197.     procedure RefreshWin;
  198.     class function CalcSize(cols, rows : Integer): TPoint;
  199.  
  200.     property Dir : TDirectory read FDir;
  201.     property Selected : TDirItem read FSelected write FSelected;
  202.     property Selection: TFileList read FSelection;
  203.     property DragCopy: Boolean read FDragCopy write SetDragCopy;
  204.     property Locked : Boolean read FLocked write FLocked;
  205.   end;
  206.  
  207. var
  208.    Xspare, YSpare: Integer;
  209.    SizeRight, DateLeft, TimeLeft, AttrLeft : Integer;
  210.  
  211. implementation
  212.  
  213. {$R *.DFM}
  214.  
  215. uses ShellAPI, FileProp, DiskProp, Drives, Busy, Graphics, Tree, Environs,
  216.   Fileman, WasteBin, FileCtrl, OpenFile, RunProg, Desk, FileFind, Debug,
  217.   Filter, Sys, Strings, MiscUtil, Files, WinProcs, Alias, FSysProp, Select, Clipbrd;
  218.  
  219.  
  220. var
  221.   PathMenu : TPopupMenu;
  222.   LastPath : TFilename;
  223.  
  224. const
  225.   LabelTop : Integer = 4;
  226.   LabelDiv : Integer = 153;
  227.  
  228.  
  229. procedure TIconWindow.FormCreate(Sender: TObject);
  230. begin
  231.   Icon.Assign(FolderIcon);
  232.   DeleteMenu(GetSystemMenu(Handle, False), SC_SIZE, MF_BYCOMMAND);
  233.   FSelection := TFileList.Create;
  234.   SelLabel.Left := LabelDiv;
  235. end;
  236.  
  237.  
  238. procedure TIconWindow.FormDestroy(Sender: TObject);
  239. begin
  240.   Desktop.RemoveWindow(self);
  241.   Dir.Free;
  242.   FSelection.Free;
  243.   if WindowOpen = woSaved then SaveDimensions;
  244. end;
  245.  
  246.  
  247. function TIconWindow.LoadDimensions: Boolean;
  248. var
  249.   l, t, w, h: Integer;
  250.   s: string[31];
  251. begin
  252.   { Loads positions and size from INI file }
  253.   s := WindowPos.Values[Caption];
  254.   if s = '' then Result := False
  255.   else try
  256.     Result := Unformat(s, '%d,%d,%d,%d', [@l, @t, @w, @h]) = 4;
  257.     if Result then begin
  258.       SetBounds(l, t, w, h);
  259.       Locked := True;
  260.     end;
  261.   except
  262.     on EConvertError do;
  263.   end;
  264. end;
  265.  
  266.  
  267. procedure TIconWindow.SaveDimensions;
  268. begin
  269.   WindowPos.Values[Caption] :=
  270.     Format('%d,%d,%d,%d', [Left, Top, Width, Height]);
  271. end;
  272.  
  273.  
  274.  
  275. procedure TIconWindow.Configure;
  276. begin
  277.   Color := Colors[ccWinFrame];
  278.  
  279.   with Grid do begin
  280.     Visible := False;
  281.     Color := Colors[ccIconBack];
  282.     SelColor := Colors[ccIconSel];
  283.     ThumbTrack := TrackThumb;
  284.  
  285.     if ViewList.Checked then begin
  286.       DefaultColWidth := Width;
  287.       DefaultRowHeight := LineHeight;
  288.       OnDrawCell := GridDrawList;
  289.     end
  290.     else begin
  291.       DefaultColWidth := BrowseGrid.X;
  292.       DefaultRowHeight := BrowseGrid.Y;
  293.     end;
  294.  
  295.     Font.Assign(GlobalFont);
  296.     Canvas.Font.Assign(Font);
  297.     SizeRight := Canvas.TextWidth('nnnnnnnn.nnn') + 30 + Canvas.TextWidth('9999.99MB');
  298.     DateLeft := SizeRight + 10;
  299.     TimeLeft := DateLeft + 6 + Canvas.TextWidth('00/00/00');
  300.     AttrLeft := TimeLeft + 10 + Canvas.TextWidth('00:00 pm');
  301.     Visible := True;
  302.   end;
  303.  
  304.   with CalcSize(4, 1), Dragger do begin
  305.     MinWidth := X;
  306.     MinHeight := Y;
  307.     Hollow := HollowDrag;
  308.   end;
  309. end;
  310.  
  311.  
  312. constructor TIconWindow.Init(AOwner: TComponent;
  313.   const foldername, filter: TFilename);
  314. begin
  315.   inherited Create(AOwner);
  316.  
  317.   { Icon windows always show a directory when opened, so a special
  318.     constructor is needed to ensure that a directory name is used. }
  319.  
  320.   FDir := TDirectory.Create(Makepath(foldername));
  321.   FDir.Filter := filter;
  322.   FDir.Scan;
  323.   FDir.OnUpdate := Arrange;
  324.  
  325.   Caption := Dir.Fullname;
  326.   Desktop.AddWindow(self);
  327.  
  328.   if WindowOpen = woRandom then
  329.     SetBounds(Random(Screen.Width - Width), Random(Screen.Height - Height - 60),
  330.       Width, Height)
  331.  
  332.   else if not ((WindowOpen = woSaved) and LoadDimensions) then begin
  333.     if Screen.ActiveForm is TIconWindow then begin
  334.       Top := Screen.ActiveForm.Top + 32;
  335.       Left := Screen.ActiveForm.Left + 32;
  336.     end
  337.     else begin
  338.        Top := (Screen.Height - Height) div 2;
  339.        Left := (Screen.Width - Width) div 2;
  340.     end;
  341.   end;
  342.  
  343.   ViewList.Checked := ShowList;
  344.   Configure;
  345.  
  346.   SetMenuCheck([SortByType, SortByName, SortBySize, SortByDate],
  347.     Integer(Dir.SortOrder));
  348.  
  349.   if Autosize and not Locked then AutoResize;
  350.   Arrange(self);
  351. end;
  352.  
  353.  
  354. procedure TIconWindow.ConstructPathMenu;
  355. var
  356.   s: TFilename;
  357.   m: TMenuItem;
  358.   i: Integer;
  359. begin
  360.   { Fills a popup menu with the list of ancestor directories. }
  361.  
  362.   s := ExtractFileDir(Dir.Fullname);
  363.   if LastPath = s then Exit;
  364.  
  365.   with PathMenu.Items do
  366.     while Count > 0 do Items[0].Free;
  367.  
  368.   while Length(s) >= 3 do begin
  369.     m := TMenuItem.Create(PathMenu);
  370.     m.Caption := s;
  371.     m.OnClick := Desktop.WindowSelect;
  372.     PathMenu.Items.Add(m);
  373.     if Length(s) = 3 then s := ''
  374.     else s := ExtractFileDir(s);
  375.   end;
  376. end;
  377.  
  378.  
  379. class function TIconWindow.CalcSize(cols, rows : Integer): TPoint;
  380. begin
  381.   Result.x := cols * BrowseGrid.X + XSpare;
  382.   Result.y := rows * BrowseGrid.Y + YSpare;
  383. end;
  384.  
  385.  
  386. procedure TIconWindow.AutoResize;
  387. var
  388.   size: TPoint;
  389. begin
  390.   { Changes the size of the window depending on the number of icons
  391.     in the list }
  392.  
  393.   if WindowState <> wsNormal then Exit;
  394.   case Dir.Count of
  395.     0..4   : size := CalcSize(4, 1);
  396.     5..8   : size := CalcSize(4, 2);
  397.     9..12  : size := CalcSize(4, 3);
  398.     13..15 : size := CalcSize(5, 3);
  399.     16..20 : size := CalcSize(5, 4);
  400.     21..24 : size := CalcSize(6, 4);
  401.     else     size := CalcSize(6, 5);
  402.   end;
  403.  
  404.   if ViewList.Checked then begin
  405.     size.x := CalcSize(4, 1).x;
  406.     if UseDescriptions then
  407.       if DescWidth > -1 then Inc(size.x, DescWidth)
  408.       else Inc(size.x, (15 * BrowseGrid.X) div 10);
  409.   end;
  410.  
  411.   { The OnResize event is only triggered when the bounds change, but
  412.     as a convention, AutoResize needs to call Resize exactly once
  413.     to reset some of the controls }
  414.  
  415.   if EqualRect(BoundsRect, Bounds(Left, Top, size.X, size.Y)) then Resize
  416.   else SetBounds(Left, Top, size.X, size.Y);
  417. end;
  418.  
  419.  
  420. procedure TIconWindow.Arrange(Sender : TObject);
  421. begin
  422.   { Called after a directory's contents have changed }
  423.  
  424.   if not (csDestroying in ComponentState) then begin
  425.     TotalLabel.Caption :=
  426.       Format('%d object%s  %s',
  427.         [Dir.Count, OneItem[Dir.Count = 1], FormatByte(Dir.Size)]);
  428.     Selsize := 0;
  429.  
  430.     with Grid, Dir do begin
  431.       Reset;                 { clear the grid }
  432.       Limit := Count;        { set the selection extent }
  433.       SizeGrid;              { adjust the rows and columns to fit }
  434.  
  435.       { The focus might be out of bounds after files have been deleted }
  436.       if (Focus >= Count) and (Count > 0) then Focus := Count-1;
  437.       GridSelect(self, Focus);
  438.     end;
  439.   end;
  440. end;
  441.  
  442.  
  443. procedure TIconWindow.FormResize(Sender: TObject);
  444. var GridBottom : Integer;
  445. begin
  446.   if WindowState <> wsMinimized then begin
  447.     Grid.SetBounds(4, 4, ClientWidth - 8, ClientHeight - 26);
  448.     TotalLabel.Top := Grid.Top + Grid.Height + LabelTop;
  449.     SelLabel.Top := TotalLabel.Top;
  450.  
  451.     with Grid do
  452.     if ViewList.Checked then
  453.       DefaultColWidth := Width - 2
  454.     else
  455.       { TCustomGrid doesn't compare the current column width with a new
  456.         setting, so DefaultColWidth should be assigned only when required }
  457.       if DefaultColWidth <> BrowseGrid.X then DefaultColWidth := BrowseGrid.X;
  458.  
  459.     Grid.SizeGrid;
  460.     Invalidate;
  461.   end;
  462. end;
  463.  
  464.  
  465.  
  466. procedure TIconWindow.FormPaint(Sender: TObject);
  467. var
  468.   r: TRect;
  469.   x, y: Integer;
  470. begin
  471.   Border3D(Canvas, ClientWidth-1, ClientHeight-1);
  472.   { Draw the status bar bevels }
  473.   r := Bounds(4, ClientHeight-19, LabelDiv-13, 16);
  474.   Frame3D(Canvas, r, clBtnShadow, clBtnHighlight, 1);
  475.   r := Bounds(LabelDiv - 5, ClientHeight-19, ClientWidth - LabelDiv + 2, 16);
  476.   Frame3D(Canvas, r, clBtnShadow, clBtnHighlight, 1);
  477.   { Draw the resize "grip" }
  478.   Canvas.Draw(ClientWidth-17, ClientHeight-17, Sizebox);
  479. end;
  480.  
  481.  
  482. function TIconWindow.FileAt(x, y : Integer; WholeCell: Boolean) : TDirItem;
  483. var
  484.   rect : TRect;
  485.   i : Integer;
  486. begin
  487.   { Returns the item at the given mouse coordinates (grid coordinate system).
  488.     If WholeCell is true, the entire grid box tested for containment,
  489.     otherwise only the icon area (approximately) is tested }
  490.  
  491.   i := Grid.MouseToCell(x, y);
  492.   rect := Grid.CellBounds(i);
  493.  
  494.   if not (ViewList.Checked or WholeCell) then begin
  495.     InflateRect(rect, -16, -8);
  496.     OffsetRect(rect, 0, -8);
  497.   end;
  498.  
  499.   if PtInRect(rect, Point(x, y)) and (i < Dir.Count) then
  500.     Result := TDirItem(Dir[i])
  501.   else Result := nil;
  502. end;
  503.  
  504.  
  505.  
  506. procedure TIconWindow.GridDragOver(Sender, Source: TObject; X, Y: Integer;
  507.   State: TDragState; var Accept: Boolean);
  508. var
  509.   f: TDirItem;
  510.   DropInIcon : Boolean;
  511.   NewDrop : Integer;
  512. begin
  513.   { Scroll the grid if the cursor is floating over the vertical
  514.     scroll bar's buttons }
  515.  
  516.   with Grid do
  517.     if (X > Width - 24) and (VisibleRowCount < RowCount) then begin
  518.       if (Y < 32) and (TopRow > 0) then
  519.         TopRow := TopRow-1
  520.       else if (Y > Height-32) and (TopRow < RowCount-VisibleRowCount) then
  521.         TopRow := TopRow+1;
  522.     end;
  523.  
  524.   if Source = SysWindow.Grid then Accept := False
  525.   else begin
  526.     { This bit is tricky...when the cursor is over a suitable icon,
  527.       the focus box is turned on.  However, when it is not over a suitable
  528.       icon, Accept can still be True because the drop target becomes
  529.       the window.  That is, Accept and DropInIcon are independent }
  530.  
  531.     f := FileAt(X, Y, False);
  532.     DropInIcon := (f <> nil) and f.AcceptsDrops;
  533.     NewDrop := Grid.MouseToCell(X, Y);
  534.     Accept := (Source <> Sender) or ((NewDrop <> Grid.Focus) and DropInIcon);
  535.  
  536.     with Grid do
  537.       if not (Accept and DropInIcon) or (State = dsDragLeave) then
  538.         DropFocus := -1
  539.       else
  540.         DropFocus := NewDrop;
  541.   end;
  542. end;
  543.  
  544.  
  545. procedure TIconWindow.GridDragDrop(Sender, Source: TObject; X, Y: Integer);
  546. var target : TDirItem;
  547. begin
  548.   Grid.DropFocus := -1;
  549.   target := FileAt(X, Y, False);
  550.  
  551.   if (target <> nil) and target.AcceptsDrops then
  552.     target.DragDrop(Source)
  553.  
  554.   else if Source is TMultiGrid then
  555.     (TMultiGrid(Source).Owner as TIconWindow).DropInWindow(Dir)
  556.  
  557.   else if Source = Bin.Listbox then
  558.     Bin.RestoreTo(Dir.Fullname)
  559. end;
  560.  
  561.  
  562. procedure TIconWindow.InitFileOp(Op : TFileOperation);
  563. begin
  564.   { Begings a file operation by initialising the progress display,
  565.     cursor and file manager }
  566.  
  567.   Desktop.SetCursor(crBusyPointer);
  568.   CompileSelection(True);
  569.   NoToAll;
  570.  
  571.   if (Selection.FolderCount > 0) or (Selection.FileCount > 1) then
  572.     ProgressBox.Init(Op, Selection.FileCount)
  573.   else
  574.     BusyBox.ShowMessage(FileOpMessages[Op]);
  575.  
  576.   if UseDescriptions and Simul4DOS then
  577.     Dir.Desc.LoadFromPath(Dir.Path);
  578. end;
  579.  
  580.  
  581. procedure TIconWindow.DoneFileOp;
  582. begin
  583.   ProgressBox.Hide;
  584.   BusyBox.Hide;
  585.   Desktop.ReleaseCursor;
  586.   Desktop.RefreshNow;
  587.   PlaySound(Sounds.Values['NotifyCompletion']);
  588.   SetFocus;
  589.   NoToAll;
  590. end;
  591.  
  592.  
  593.  
  594. function TIconWindow.InitCopy(const dest : string): Boolean;
  595. begin
  596.   Result := not (ConfirmCopyStart and
  597.     (MsgDialog(Format('Copy %d item%s from %s to %s?',
  598.        [Grid.SelCount, OneItem[Grid.SelCount = 1], Dir.Fullname, dest]),
  599.        mtConfirmation, [mbYes, mbNo], 0) <> mrYes));
  600.  
  601.   if Result then InitFileOp(foCopy);
  602. end;
  603.  
  604.  
  605. function TIconWindow.InitMove(const dest: string) : Boolean;
  606. begin
  607.   Result := not (ConfirmMoveStart and
  608.     (MsgDialog(Format('Move %d item%s from %s to %s?',
  609.        [Grid.SelCount, OneItem[Grid.SelCount = 1], Dir.Fullname, dest]),
  610.        mtConfirmation, [mbYes, mbNo], 0) <> mrYes));
  611.  
  612.   if Result then InitFileOp(foMove);
  613. end;
  614.  
  615.  
  616. function TIconWindow.InitDelete(const dest: string) : Boolean;
  617. begin
  618.   Result := not (ConfirmDelStart and
  619.     (MsgDialog(Format('Delete %d item%s from %s?',
  620.     [Grid.Selcount, OneItem[Grid.SelCount = 1], dest]),
  621.     mtConfirmation, [mbYes, mbNo], 0) <> mrYes));
  622.  
  623.   if Result then InitFileOp(foDelete);
  624. end;
  625.  
  626.  
  627. procedure TIconWindow.DropInFolder(const foldername : TFilename);
  628. var
  629.   i : Integer;
  630.   path : TFilename;
  631. begin
  632.   { Copies or moves selected items from this window into a
  633.     specified folder.  If the folder is being shown in an icon window,
  634.     DropInWindow should be used instead. }
  635.  
  636.   path := MakePath(foldername);
  637.   if path = Dir.Path then begin
  638.     ErrorMsg('Cannot copy or move items onto themselves');
  639.     Exit;
  640.   end;
  641.  
  642.   case DragCopy of
  643.     True : if not InitCopy(foldername) then exit;
  644.     False: if not InitMove(foldername) then exit;
  645.   end;
  646.   try
  647.     if DragCopy then
  648.       for i := 0 to Selection.count-1 do TDirItem(Selection[i]).CopyToPath(path)
  649.     else
  650.       for i := 0 to Selection.Count-1 do TDirItem(Selection[i]).MoveToPath(path);
  651.   finally
  652.     if not DragCopy then Dir.Flush;
  653.     DoneFileOp;
  654.   end;
  655. end;
  656.  
  657.  
  658. procedure TIconWindow.DropInWindow(d : TDirectory);
  659. var i: Integer;
  660. begin
  661.   { Copies or moves selected items from this window into another window,
  662.     represented by its directory object }
  663.  
  664.   if d = Dir then begin
  665.     ErrorMsg('Cannot copy or move items onto themselves');
  666.     exit;
  667.   end;
  668.  
  669.   if UseDescriptions and Simul4DOS then
  670.     d.Desc.LoadFromPath(d.Path);
  671.  
  672.   case DragCopy of
  673.     True : if not InitCopy(d.Fullname) then exit;
  674.     False: if not InitMove(d.Fullname) then exit;
  675.   end;
  676.  
  677.   try
  678.     if DragCopy then
  679.        for i := 0 to Selection.count-1 do TDirItem(Selection[i]).CopyToDirectory(d)
  680.     else
  681.        for i := 0 to Selection.count-1 do TDirItem(Selection[i]).MoveToDirectory(d);
  682.   finally
  683.     if not DragCopy then Dir.Flush;
  684.     d.Flush;
  685.     DoneFileOp;
  686.   end;
  687. end;
  688.  
  689.  
  690.  
  691. procedure TIconWindow.ObjectMenuPopup(Sender: TObject);
  692. var
  693.   valid : Boolean;
  694.   IsFile : Boolean;
  695. begin
  696.   { Hide inappropriate menu items, depending on the currently
  697.     "focused" object.  }
  698.  
  699.   valid := Selected <> nil;
  700.   IsFile := Selected is TFileItem;
  701.  
  702.   Describe.Visible := UseDescriptions;
  703.   Open.Visible := valid;
  704.   OpenWith.Visible := IsFile;
  705.   Inspect.Visible := IsFile and (InspectProg > '');
  706.   Duplicate.Visible := Selected is TFile;
  707.   AliasProp.Visible := Selected is TAlias;
  708.   Properties.Visible := valid;
  709.   Rename.Visible := valid;
  710.   Delete.Visible := valid;
  711.   CreateAlias.Visible := valid and not (Selected is TAlias);
  712. end;
  713.  
  714.  
  715. procedure TIconWindow.OpenClick(Sender: TObject);
  716. begin
  717.   if Selected <> nil then Selected.Open;
  718. end;
  719.  
  720.  
  721. procedure TIconWindow.DeleteClick(Sender: TObject);
  722. var i : Integer;
  723. begin
  724.   if (Grid.SelCount > 0) and InitDelete(Dir.Fullname) then
  725.   try
  726.     for i := 0 to Selection.Count-1 do TDirItem(Selection[i]).Delete;
  727.   finally
  728.     Dir.Flush;
  729.     DoneFileOp;
  730.   end;
  731. end;
  732.  
  733.  
  734. procedure TIconWindow.CreateFolderClick(Sender: TObject);
  735. var s: TFilename;
  736. begin
  737.   s := '';
  738.   if InputQuery('Create folder', 'New folder name', s) then
  739.     Dir.CreateFolder(Lowercase(s));
  740. end;
  741.  
  742.  
  743. procedure TIconWindow.DrawLasso(r: TRect);
  744. begin
  745.   { Draw the "column of marching ants" selection box, like the
  746.     one used in Delphi's form editor.  PolyLine must be used for
  747.     this effect -- MoveTo and LineTo don't work }
  748.  
  749.   with Grid.Canvas do begin
  750.     Pen.Style := psDot;
  751.     Pen.Mode := pmXor;
  752.     PolyLine([Point(r.Left, r.Top), Point(r.Right, r.Top),
  753.       Point(r.Right, r.Bottom), Point(r.Left, r.Bottom),
  754.       Point(r.Left, r.Top)]);
  755.   end;
  756. end;
  757.  
  758.  
  759. procedure TIconWindow.GridMouseDown(Sender: TObject; Button: TMouseButton;
  760.   Shift: TShiftState; X, Y: Integer);
  761. var
  762.   p : TPoint;
  763.   r : TRect;
  764. begin
  765.   if not (ssDouble in Shift) then begin
  766.  
  767.     if Button = mbLeft then begin
  768.       if (FileAt(X, Y, False) <> nil) and (Grid.SelCount > 0) then with Grid do begin
  769.         { Start dragging when clicking over an icon }
  770.         DragCopy := not (ssAlt in Shift);
  771.         BeginDrag(False);
  772.       end
  773.       else with Grid do begin
  774.         { Start lasso selection when clicking over empty space }
  775.         Stretching := True;
  776.         Update;
  777.         Anchor := Point(X, Y);
  778.         Corner := Anchor;
  779.         with ClientRect do begin
  780.           r.TopLeft := ClientToScreen(TopLeft);
  781.           r.BottomRight := ClientToScreen(Bottomright);
  782.           ClipCursor(@r);
  783.         end;
  784.       end;
  785.     end
  786.  
  787.     else if Grid.Dragging then
  788.       { Toggle move/copy when right clicking during file drag }
  789.       DragCopy := not DragCopy
  790.  
  791.     else if not Stretching then with Grid do begin
  792.       { Display appropriate context menu }
  793.       GetCursorPos(p);
  794.       if FileAt(X, Y, False) = nil then
  795.         WinMenu.Popup(p.x, p.y)
  796.       else begin
  797.         Select(MouseToCell(X, Y));
  798.         if SelCount > 0 then ObjectMenu.Popup(p.x, p.y);
  799.       end;
  800.     end;
  801.   end;
  802. end;
  803.  
  804.  
  805. procedure TIconWindow.FormDragOver(Sender, Source: TObject; X, Y: Integer;
  806.   State: TDragState; var Accept: Boolean);
  807. begin
  808.   Accept := (Source <> Grid) and (Source <> SysWindow.Grid);
  809. end;
  810.  
  811.  
  812. procedure TIconWindow.OpenWithClick(Sender: TObject);
  813. var s: TFilename;
  814. begin
  815.   if not (Selected is TFileItem) then exit;
  816.   s := TOpenFileDlg.Execute;
  817.   if s > '' then TFileItem(Selected).OpenWith(s);
  818. end;
  819.  
  820.  
  821. procedure TIconWindow.PropertiesClick(Sender: TObject);
  822. begin
  823.   if Grid.SelCount > 0 then
  824.  
  825.   with TFilePropDlg.Create(Application) do
  826.   try
  827.     if Grid.Selcount = 1 then SetItem(Selected)
  828.     else SetItem(CompileSelection(True));
  829.     ShowModal;
  830.   finally
  831.     Free;
  832.   end;
  833. end;
  834.  
  835.  
  836. procedure TIconWindow.GridCellSelected(Sender: TObject; Index : Integer;
  837.   IsSelected: Boolean);
  838. var s: Longint;
  839. begin
  840.   { Called once for each selection or deselection in the grid.  If the
  841.     user selects 100 files in one go, this is called 100 times, so keep
  842.     the code short }
  843.  
  844.   if Index < Dir.Count then begin
  845.     s := TDirItem(Dir[Index]).Size;
  846.     if IsSelected then Inc(Selsize, s) else Dec(Selsize, s);
  847.   end;
  848. end;
  849.  
  850.  
  851. procedure TIconWindow.RenameClick(Sender: TObject);
  852. var s: TFilename;
  853. begin
  854.   if Selected <> nil then with Selected do begin
  855.     s := Filename;
  856.     if InputQuery('Rename ' + Filename, 'New filename', s) then begin
  857.       if UseDescriptions and Simul4DOS then
  858.         Dir.Desc.LoadFromPath(Dir.Path);
  859.       Filename := Lowercase(s);
  860.       Dir.Update;
  861.     end;
  862.   end;
  863. end;
  864.  
  865.  
  866. procedure TIconWindow.GridKeyPress(Sender: TObject; var Key: Char);
  867. var
  868.   c: Char;
  869.   i, foc: Integer;
  870.   found : Boolean;
  871. begin
  872.   case Key of
  873.    { Standard window management }
  874.    '-': Desktop.ClosePathWindows(Dir.Fullname);
  875.    '+': Desktop.CloseLowerWindows(Dir.Fullname);
  876.    '*': Desktop.CloseOtherWindows(self);
  877.    '/': Desktop.CloseWindows;
  878.    '\': Desktop.OpenFolder(Dir.Path[1] + ':\');
  879.  
  880.   else
  881.     { Jump to the next object which begins with this character }
  882.  
  883.     with Dir do if Count > 1 then begin
  884.       c := LowCase(Key);
  885.       foc := Grid.Focus;
  886.       i := (foc + 1) mod Count;
  887.  
  888.       while (i <> foc) and (LowCase(TDirItem(List^[i]).GetTitle[1]) <> c) do
  889.         i := (i + 1) mod Count;
  890.  
  891.       if i <> foc then Grid.Select(i);
  892.     end;
  893.   end;
  894. end;
  895.  
  896.  
  897. procedure TIconWindow.FormDragDrop(Sender, Source: TObject; X, Y: Integer);
  898. begin
  899.   if Source is TMultiGrid then
  900.     TIconWindow(TMultiGrid(Source).Owner).DropInWindow(Dir)
  901.  
  902.   else if Source = Bin.Listbox then
  903.     Bin.RestoreTo(Dir.Fullname)
  904.  
  905.   else if Source = FindList then
  906.     ProcessFiles(FindForm.CompileSelection, Dir.Fullname);
  907. end;
  908.  
  909.  
  910. procedure TIconWindow.RefreshWin;
  911. begin
  912.   try
  913.     Dir.Scan;
  914.     if AutoSize and not Locked then AutoResize;
  915.     Arrange(self);
  916.   except
  917.     on EScanError do Close;
  918.   end;
  919. end;
  920.  
  921.  
  922. procedure TIconWindow.RunClick(Sender: TObject);
  923. begin
  924.   ChDir(Dir.Fullname);
  925.   if Selected <> nil then RunExecute(Selected.Filename)
  926.   else RunExecute('');
  927. end;
  928.  
  929.  
  930. procedure TIconWindow.CreateAliasClick(Sender: TObject);
  931. var
  932.   fname : TFilename;
  933. begin
  934.   if Selected <> nil then begin
  935.     fname := ChangeFileExt(Selected.Fullname, '.als');
  936.  
  937.     if (ConfirmNewAlias or not (dfWriteable in GetDriveFlags(Caption[1]))) and
  938.       not InputQuery('Create alias', 'Alias filename', fname) then Exit;
  939.  
  940.     Selected.WriteAlias(Lowercase(fname));
  941.   end;
  942. end;
  943.  
  944.  
  945. procedure TIconWindow.SetFilterClick(Sender: TObject);
  946. begin
  947.   with TFilterDialog.Create(Application) do
  948.   try
  949.     FilterEdit.Text := Dir.Filter;
  950.     ShowHidSys.Checked := Dir.Mask and faHidden <> 0;
  951.     if ShowModal = mrOK then begin
  952.       Dir.Filter := FilterEdit.Text;
  953.       if ShowHidSys.Checked then Dir.Mask := Dir.Mask or faHidSys
  954.       else Dir.Mask := Dir.Mask and not faHidSys;
  955.       Dir.Scan;
  956.       Dir.Update;
  957.     end;
  958.   finally
  959.     Free;
  960.   end;
  961. end;
  962.  
  963.  
  964. procedure TIconWindow.SortByTypeClick(Sender: TObject);
  965. begin
  966.   { Handles all "sorting" menu item events }
  967.   with Sender as TMenuItem do
  968.     if not Checked then begin
  969.       SetMenuCheck([SortByType, SortByName, SortBySize, SortByDate], Tag);
  970.       Dir.SortOrder := TSortOrder(Tag);
  971.       Dir.Sort;
  972.       Dir.Update;
  973.     end;
  974. end;
  975.  
  976.  
  977. function TIconWindow.CompileSelection(recurse: Boolean): TFileList;
  978. var i: Integer;
  979. begin
  980.   { Fills a TFileList with the current selection.  Recurse controls
  981.     whether subdirectories have their content sizes counted.  Use
  982.     this instead of the TDirectory object when items may be moved
  983.     or deleted }
  984.  
  985.   Desktop.SetCursor(crHourGlass);
  986.   with Selection do begin
  987.     Clear;
  988.     Capacity := max(Capacity, Grid.SelCount);
  989.     Selection.DeepScan := recurse;
  990.     for i := 0 to Dir.Count-1 do
  991.       if Grid.Selected[i] then Selection.Add(Dir[i]);
  992.   end;
  993.   Desktop.ReleaseCursor;
  994.   Result := Selection;
  995. end;
  996.  
  997.  
  998. procedure TIconWindow.UndeleteClick(Sender: TObject);
  999. begin
  1000.   ExecuteFile(EnvironSubst(UndeleteProg), '', Dir.Fullname,
  1001.     'Open', SW_SHOWNORMAL);
  1002. end;
  1003.  
  1004.  
  1005. procedure TIconWindow.GridKeyDown(Sender: TObject; var Key: Word;
  1006.   Shift: TShiftState);
  1007. var
  1008.   item : TMenuItem;
  1009.   s: TFilename;
  1010.   p: PChar;
  1011. begin
  1012.   { The grid can only have one PopupMenu property, so the window menu
  1013.     is searched manually for a shortcut match }
  1014.   s := '';
  1015.   item := WinMenu.FindItem(Shortcut(Key, Shift), fkShortcut);
  1016.  
  1017.   if item <> nil then item.Click
  1018.   else begin
  1019.     { Handle keyboard commands not in menus }
  1020.  
  1021.     if (Key = VK_BACK) and (Shift + [ssAlt] = [ssAlt]) then begin
  1022.       if Length(Dir.Path) > 3 then
  1023.         Desktop.OpenFolder(ExtractFileDir(Dir.Fullname))
  1024.       else
  1025.         SysWindow.ShowNormal;
  1026.     end
  1027.  
  1028.     else if (Shift = [ssCtrl, ssShift]) and (Chr(Key) in ValidDrives) then
  1029.       { Ctrl+Alt+Letter opens the root directory }
  1030.       Desktop.OpenFolder(LowCase(Chr(Key)) + ':\')
  1031.  
  1032.     else if Shift = [ssCtrl] then
  1033.       case key of
  1034.         Ord('C'): Clipboard.AsText := Dir.Path + Dir.Filter;
  1035.         Ord('E'): OpenExplorer(Dir.Fullname);
  1036.         Ord('F'): FileFindExecute(Dir.Fullname, 1);
  1037.         Ord('P'): begin
  1038.                     if Selected <> nil then s := Selected.Filename;
  1039.                     if InputQuery('Print file', 'Filename', s) then
  1040.                       ExecuteFile(s, '', Dir.Fullname, 'print', SW_SHOWNORMAL);
  1041.                   end;
  1042.         Ord('O'): if InputQuery('Open folder', 'Folder name', s) then
  1043.                     Desktop.OpenFolder(s);
  1044.         VK_F5   : Desktop.Cascade;
  1045.       end
  1046.  
  1047.     else if (Shift = [ssShift]) and (key = VK_F5) then
  1048.       Desktop.ArrangeIcons
  1049.  
  1050.     else if Shift = [] then
  1051.       case Key of
  1052.         VK_F5   : RefreshWin;
  1053.         VK_F12  : Application.Minimize;
  1054.       end;
  1055.   end;
  1056. end;
  1057.  
  1058.  
  1059. procedure TIconWindow.WMSysCommand(var Msg: TWMSysCommand);
  1060. begin
  1061.   inherited;
  1062.   case Msg.CmdType and $FFF0 of
  1063.     SC_MINIMIZE: PlaySound(Sounds.Values['WindowMinimize']);
  1064.     SC_MAXIMIZE: PlaySound(Sounds.Values['WindowMaximize']);
  1065.     SC_RESTORE : PlaySound(Sounds.Values['WindowRestore']);
  1066.     SC_CLOSE   : PlaySound(Sounds.Values['WindowClose']);
  1067.   end;
  1068. end;
  1069.  
  1070.  
  1071. procedure TIconWindow.FormShow(Sender: TObject);
  1072. begin
  1073.   PlaySound(Sounds.Values['WindowOpen']);
  1074.   if IconWindowTask then
  1075.     PostMessage(TaskbarWindow, WM_CALMIRA, CM_ADDCALWINDOW, Handle);
  1076. end;
  1077.  
  1078.  
  1079. procedure TIconWindow.DuplicateClick(Sender: TObject);
  1080. var s: string;
  1081. begin
  1082.    if not (Selected is TFileItem) then exit;
  1083.  
  1084.    s := '';
  1085.    if InputQuery('Duplicate '+Selected.Filename, 'New filename', s) then begin
  1086.      (Selected as TFileItem).Duplicate(Lowercase(s));
  1087.      Dir.Update;
  1088.    end;
  1089. end;
  1090.  
  1091.  
  1092. procedure TIconWindow.GridDrawCell(Sender: TObject; Index: Integer;
  1093.   Rect: TRect; State: TGridDrawState);
  1094. begin
  1095.   TDirItem(Dir[Index]).Draw(Grid.Canvas, Rect);
  1096. end;
  1097.  
  1098.  
  1099. procedure TIconWindow.GridDrawList(Sender: TObject; Index: Integer;
  1100.   Rect: TRect; State: TGridDrawState);
  1101. begin
  1102.   TDirItem(Dir[Index]).DrawAsText(Grid.Canvas, Rect)
  1103. end;
  1104.  
  1105.  
  1106. procedure TIconWindow.GridSelectCell(Sender: TObject; Index: Integer;
  1107.   var CanSelect: Boolean);
  1108. begin
  1109.   CanSelect := not Stretching;
  1110. end;
  1111.  
  1112.  
  1113. procedure TIconWindow.DropServerFileDrop(Sender: TObject; X, Y: Integer;
  1114.   Target: Word);
  1115. var i: Integer;
  1116. begin
  1117.   if Grid.SelCount > 0 then
  1118.     with DropServer do
  1119.       for i := 0 to Dir.Count-1 do
  1120.         if Grid.Selected[i] then Files.Add(TDirItem(Dir[i]).Fullname);
  1121. end;
  1122.  
  1123.  
  1124. procedure TIconWindow.TotalLabelMouseDown(Sender: TObject;
  1125.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  1126. begin
  1127.   if Button = mbRight then DiskPropExecute(Upcase(Dir.Path[1]));
  1128. end;
  1129.  
  1130.  
  1131. procedure TIconWindow.GridMouseUp(Sender: TObject; Button: TMouseButton;
  1132.   Shift: TShiftState; X, Y: Integer);
  1133. var
  1134.   r, s: TRect;
  1135.   i, count, topitem: Integer;
  1136. begin
  1137.   if Button <> mbLeft then exit;
  1138.   ClipCursor(nil);
  1139.   with Grid do begin
  1140.     count := Grid.SelCount;
  1141.  
  1142.     if Stretching then begin
  1143.       { Select files inside lasso }
  1144.       Stretching := False;
  1145.       R := NormalizeRect(Anchor, Corner);
  1146.       DrawLasso(R);
  1147.       topitem := Toprow * ColCount;
  1148.       for i := topitem to Min(Dir.Count,
  1149.        topitem + (VisibleColCount * (VisibleRowCount+1)))-1 do begin
  1150.  
  1151.         s := CellBounds(i);
  1152.         InflateRect(s, -16, -8);
  1153.         if Intersects(R, S) then Selected[i] := True;
  1154.       end;
  1155.     end;
  1156.  
  1157.     { Deselect when the user clicks in an empty area, provided that
  1158.       no new files were selected and a drag hasn't just finished }
  1159.  
  1160.     if (count = SelCount) and not DragJustEnded and
  1161.       (FileAt(X, Y, True) = nil) and (Dir.Count > 0) then
  1162.       DeselectAll;
  1163.  
  1164.     GridSelect(self, Focus);
  1165.   end;
  1166.   DragJustEnded := False;
  1167. end;
  1168.  
  1169.  
  1170. procedure TIconWindow.GridEndDrag(Sender, Target: TObject; X, Y: Integer);
  1171. begin
  1172.   DragJustEnded := True;
  1173.   DropServer.DragFinished;
  1174. end;
  1175.  
  1176.  
  1177. procedure TIconWindow.SelLabelMouseDown(Sender: TObject;
  1178.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  1179. begin
  1180.   if Button = mbLeft then
  1181.     with Grid do
  1182.       if SelCount = 0 then SelectAll
  1183.       else DeselectAll
  1184.  
  1185.   else if Button = mbRight then
  1186.     Select.Click;
  1187. end;
  1188.  
  1189.  
  1190. procedure TIconWindow.GridMouseMove(Sender: TObject; Shift: TShiftState; X,
  1191.   Y: Integer);
  1192. begin
  1193.  if Grid.Dragging then begin
  1194.     if DropServer.CanDrop and AnimCursor then
  1195.       SetCursor(Screen.Cursors[crFlutter]);
  1196.  end
  1197.  else if Stretching then begin
  1198.     { erase previous lasso and redraw }
  1199.     DrawLasso(NormalizeRect(Anchor, Corner));
  1200.     Corner := Point(X, Y);
  1201.     DrawLasso(NormalizeRect(Anchor, Corner));
  1202.   end;
  1203. end;
  1204.  
  1205.  
  1206. procedure TIconWindow.DropClientDropFiles(Sender: TObject);
  1207. var target : TDirItem;
  1208. begin
  1209.   with DropClient do
  1210.   if (WindowState <> wsMinimized) and PtInRect(Grid.BoundsRect, DropPos) then begin
  1211.  
  1212.     target := FileAt(DropPos.x, DropPos.y, False);
  1213.  
  1214.     if (target <> nil) and target.AcceptsDrops then
  1215.       target.DragDrop(Files)
  1216.     else
  1217.       ProcessFiles(Files, Dir.Fullname)
  1218.   end
  1219.   else ProcessFiles(Files, Dir.Fullname)
  1220. end;
  1221.  
  1222.  
  1223. procedure TIconWindow.FolderRenamed(const previous, current: TFilename);
  1224. var s: TFilename;
  1225. begin
  1226.   { Search for the ancestor which has been renamed and change that
  1227.     part of the string to the new name }
  1228.  
  1229.   s := Dir.Fullname;
  1230.   if (previous = s) or IsAncestorDir(previous, s) then begin
  1231.     System.Delete(s, 1, Length(previous));
  1232.     Desktop.RemoveWindow(self);
  1233.     Dir.Path := current + s + '\';
  1234.     Caption := Dir.Fullname;
  1235.     Desktop.AddWindow(self);
  1236.   end;
  1237. end;
  1238.  
  1239.  
  1240. procedure TIconWindow.DropServerDeskDrop(Sender: TObject; X, Y: Integer;
  1241.   Target: Word);
  1242. begin
  1243.   if Selected <> nil then
  1244.     Selected.CreateShortcut.MinPosition := Point(X - 16, Y - 16);
  1245. end;
  1246.  
  1247.  
  1248. procedure TIconWindow.WMNCRButtonDown(var Msg: TWMNCRButtonDown);
  1249. begin
  1250.   inherited;
  1251.   with Msg do
  1252.     if HitTest = HTSYSMENU then begin
  1253.       ConstructPathMenu;
  1254.       PathMenu.Popup(XCursor, YCursor);
  1255.     end;
  1256. end;
  1257.  
  1258.  
  1259. function TIconWindow.CompileFilenames: TStringList;
  1260. var i: Integer;
  1261. begin
  1262.   { Just returns a new list of filenames.  Compare CompileSelection method }
  1263.   Result := TStringList.Create;
  1264.   for i := 0 to Dir.Count-1 do
  1265.     if Grid.Selected[i] then Result.Add(TDirItem(Dir[i]).Fullname);
  1266. end;
  1267.  
  1268.  
  1269. procedure TIconWindow.SetDragCopy(copy: Boolean);
  1270. const
  1271.   DragCursors : array[Boolean, Boolean] of TCursor =
  1272.     ( (crDropFile, crDropMulti), (crDropCopy, crDropMultiCopy ));
  1273. begin
  1274.   { Sets the cursor shape depending on whether copy mode is on, and
  1275.     how many items are selected }
  1276.  
  1277.   FDragCopy := copy;
  1278.   with Grid do DragCursor := DragCursors[FDragCopy, SelCount > 1];
  1279.   RefreshCursor;
  1280. end;
  1281.  
  1282.  
  1283. procedure TIconWindow.FormDblClick(Sender: TObject);
  1284. const
  1285.   NewStates : array[TWindowState] of TWindowState =
  1286.     (wsMaximized, wsMinimized, wsNormal);
  1287. begin
  1288.   WindowState := NewStates[WindowState];
  1289. end;
  1290.  
  1291.  
  1292. procedure TIconWindow.GridSelect(Sender: TObject; Index: Integer);
  1293. const
  1294.   Labels : array[Boolean] of string[23] =
  1295.     ('Selected %d items  %s', 'Selected %d item  %s');
  1296. begin
  1297.   { Called whenever the selection has changed }
  1298.  
  1299.   if (index < Dir.Count) and (Grid.SelCount > 0) then
  1300.     Selected := TDirItem(Dir[index])
  1301.   else begin
  1302.     Selected := nil;
  1303.     if Dir.Count = 0 then Grid.Focus := 0;
  1304.   end;
  1305.  
  1306.   SelLabel.Caption := Format(Labels[Grid.SelCount = 1],
  1307.     [Grid.SelCount, FormatByte(Selsize)]);
  1308. end;
  1309.  
  1310.  
  1311. procedure TIconWindow.InspectClick(Sender: TObject);
  1312. begin
  1313.   if Selected is TFileItem then
  1314.     TFileItem(Selected).OpenWith(EnvironSubst(InspectProg));
  1315. end;
  1316.  
  1317.  
  1318. procedure TIconWindow.ChangeDir(const foldername : string);
  1319. begin
  1320.   if foldername = Caption then exit;
  1321.   Desktop.RemoveWindow(self);
  1322.   Dir.Path := MakePath(foldername);
  1323.   Caption := Dir.Fullname;
  1324.   Desktop.AddWindow(self);
  1325.   RefreshWin;
  1326. end;
  1327.  
  1328.  
  1329. procedure TIconWindow.ViewListClick(Sender: TObject);
  1330. begin
  1331.   ViewList.Checked := not ViewList.Checked;
  1332.  
  1333.   with Grid do begin
  1334.     Visible := False;
  1335.     if ViewList.Checked then begin
  1336.       DefaultRowHeight := LineHeight;
  1337.       OnDrawCell := GridDrawList;
  1338.     end
  1339.     else begin
  1340.       DefaultRowHeight := BrowseGrid.Y;
  1341.       OnDrawCell := GridDrawCell;
  1342.     end;
  1343.     if AutoSize and not Locked and (WindowState = wsNormal) then AutoResize
  1344.     else Resize;
  1345.     Visible := True;
  1346.     SetFocus;
  1347.   end;
  1348. end;
  1349.  
  1350.  
  1351. procedure TIconWindow.FormMouseDown(Sender: TObject; Button: TMouseButton;
  1352.   Shift: TShiftState; X, Y: Integer);
  1353. var p: TPoint;
  1354. begin
  1355.   if (Dragger.DragState = fdNone) and (Button = mbRight) then begin
  1356.     GetCursorPos(p);
  1357.     WinMenu.Popup(p.X, p.Y);
  1358.   end;
  1359. end;
  1360.  
  1361.  
  1362. procedure TIconWindow.TotalLabelClick(Sender: TObject);
  1363. begin
  1364.   RefreshWin;
  1365. end;
  1366.  
  1367.  
  1368. procedure TIconWindow.AliasPropClick(Sender: TObject);
  1369. begin
  1370.   if Selected is TAlias then TAlias(Selected).Edit;
  1371. end;
  1372.  
  1373.  
  1374. procedure TIconWindow.WMActivate(var Msg : TWMActivate);
  1375. begin
  1376.   inherited;
  1377.   if Msg.Active = WA_INACTIVE then Application.HintPause := 800
  1378.   else Application.HintPause := HintDelay;
  1379. end;
  1380.  
  1381.  
  1382. procedure TIconWindow.FormHide(Sender: TObject);
  1383. begin
  1384.   if IconWindowTask then
  1385.     PostMessage(TaskbarWindow, WM_CALMIRA, CM_DELCALWINDOW, Handle);
  1386. end;
  1387.  
  1388.  
  1389. procedure TIconWindow.DescribeClick(Sender: TObject);
  1390. var i: Integer;
  1391. begin
  1392.   if Grid.Selcount = 0 then Exit;
  1393.  
  1394.   if UseDescriptions and Simul4DOS then
  1395.     Dir.Desc.LoadFromPath(Dir.Path);
  1396.  
  1397.   CompileSelection(False);
  1398.   for i := 0 to Selection.count-1 do
  1399.     if not TDirItem(Selection[i]).EditDescription then Break;
  1400.  
  1401.   Dir.Desc.SaveToPath(Dir.Path);
  1402.   Grid.Invalidate;
  1403. end;
  1404.  
  1405.  
  1406. procedure TIconWindow.FileSystemClick(Sender: TObject);
  1407. begin
  1408.   ShowModalDialog(TFileSysPropDlg);
  1409. end;
  1410.  
  1411. procedure TIconWindow.SettingsChanged(Changes: TSettingChanges);
  1412. begin
  1413.   if [scSystem, scFileSystem, scDesktop, scDisplay] * Changes <> [] then
  1414.     Configure;
  1415.   if sc4DOS in Changes then RefreshWin;
  1416. end;
  1417.  
  1418.  
  1419. procedure TIconWindow.SelectClick(Sender: TObject);
  1420. begin
  1421.   with TSelectFileDlg.Create(Application) do
  1422.     try
  1423.       OnSelectFiles := SelectFileHandler;
  1424.       ShowModal;
  1425.     finally
  1426.       Free;
  1427.     end;
  1428. end;
  1429.  
  1430.  
  1431.  
  1432. procedure TIconWindow.SelectFileHandler(Sender : TObject;
  1433.   const FileSpec : string; select : Boolean);
  1434. var i: Integer;
  1435. begin
  1436.   for i := 0 to Dir.Count-1 do
  1437.     if WildCardMatch(TDirItem(Dir[i]).Filename, FileSpec) then
  1438.       Grid.Selected[i] := select;
  1439.   GridSelect(self, Grid.Focus);
  1440. end;
  1441.  
  1442.  
  1443.  
  1444. procedure TIconWindow.WinMenuPopup(Sender: TObject);
  1445. begin
  1446.   Select.Enabled := Dir.Count > 0;
  1447.   SetFilter.Checked := Dir.Filter <> DefaultFilter;
  1448. end;
  1449.  
  1450. procedure TIconWindow.GridDblClick(Sender: TObject);
  1451. begin
  1452.   if (GetAsyncKeyState(VK_SHIFT) < 0) and (Selected is TFolder) then
  1453.     OpenExplorer(Selected.Fullname)
  1454.   else
  1455.     Open.Click;
  1456. end;
  1457.  
  1458. procedure TIconWindow.FormClose(Sender: TObject; var Action: TCloseAction);
  1459. begin
  1460.   Action := caFree;
  1461. end;
  1462.  
  1463. initialization
  1464.   PathMenu := TPopupMenu.Create(Application);
  1465.   Xspare := GetSystemMetrics(SM_CYVSCROLL) + 13;
  1466.   Yspare := GetSystemMetrics(SM_CYCAPTION) + 29;
  1467.  
  1468.   if Screen.PixelsPerInch > 96 then begin
  1469.     LabelTop := 2;
  1470.     LabelDiv := 170;
  1471.   end;
  1472. end.
  1473.