home *** CD-ROM | disk | FTP | other *** search
/ PC Open 19 / pcopen19.iso / Zipped / CALMIR21.ZIP / SOURCE.ZIP / SRC / ICONWIN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-02-20  |  50.3 KB  |  1,816 lines
  1. {**************************************************************************}
  2. {                                                                          }
  3. {    Calmira shell for Microsoft« Windows(TM) 3.1                          }
  4. {    Source Release 2.1                                                    }
  5. {    Copyright (C) 1997-1998 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;
  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.     Duplicate: TMenuItem;
  67.     Grid: TMultiGrid;
  68.     DropServer: TDropServer;
  69.     DropClient: TDropClient;
  70.     WinMenu: TPopupMenu;
  71.     CreateFolder: TMenuItem;
  72.     Run: TMenuItem;
  73.     N1: TMenuItem;
  74.     SetFilter: TMenuItem;
  75.     SortbyType: TMenuItem;
  76.     SortbyName: TMenuItem;
  77.     SortbySize: TMenuItem;
  78.     SortbyDate: TMenuItem;
  79.     N2: TMenuItem;
  80.     Inspect: TMenuItem;
  81.     ViewList: TMenuItem;
  82.     AliasProp: TMenuItem;
  83.     Describe: TMenuItem;
  84.     FileSystem: TMenuItem;
  85.     NewAlias: TMenuItem;
  86.     LargeIcons: TMenuItem;
  87.     SmallIcons: TMenuItem;
  88.     N3: 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 SetFilterClick(Sender: TObject);
  112.     procedure SortByTypeClick(Sender: TObject);
  113.     procedure GridKeyDown(Sender: TObject; var Key: Word;
  114.       Shift: TShiftState);
  115.     procedure FormShow(Sender: TObject);
  116.     procedure DuplicateClick(Sender: TObject);
  117.     procedure GridDrawCell(Sender: TObject; Index: Integer;
  118.       Rect: TRect; State: TGridDrawState);
  119.     procedure GridSelectCell(Sender: TObject; Index: Integer;
  120.       var CanSelect: Boolean);
  121.     procedure DropServerFileDrop(Sender: TObject; X, Y: Integer;
  122.       Target: Word);
  123.     procedure TotalLabelMouseDown(Sender: TObject; Button: TMouseButton;
  124.       Shift: TShiftState; X, Y: Integer);
  125.     procedure GridMouseUp(Sender: TObject; Button: TMouseButton;
  126.       Shift: TShiftState; X, Y: Integer);
  127.     procedure GridEndDrag(Sender, Target: TObject; X, Y: Integer);
  128.     procedure SelLabelMouseDown(Sender: TObject; Button: TMouseButton;
  129.       Shift: TShiftState; X, Y: Integer);
  130.     procedure GridMouseMove(Sender: TObject; Shift: TShiftState; X,
  131.       Y: Integer);
  132.     procedure DropClientDropFiles(Sender: TObject);
  133.     procedure DropServerDeskDrop(Sender: TObject; X, Y: Integer;
  134.       Target: Word);
  135.     procedure FormDblClick(Sender: TObject);
  136.     procedure GridSelect(Sender: TObject; Index: Integer);
  137.     procedure InspectClick(Sender: TObject);
  138.     procedure ViewListClick(Sender: TObject);
  139.     procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
  140.       Shift: TShiftState; X, Y: Integer);
  141.     procedure AliasPropClick(Sender: TObject);
  142.     procedure FormHide(Sender: TObject);
  143.     procedure DescribeClick(Sender: TObject);
  144.     procedure FileSystemClick(Sender: TObject);
  145.     procedure GridDblClick(Sender: TObject);
  146.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  147.     procedure NewAliasClick(Sender: TObject);
  148.     procedure TotalLabelClick(Sender: TObject);
  149.     procedure WinMenuPopup(Sender: TObject);
  150.   private
  151.     { Private declarations }
  152.     FDir : TDirectory;
  153.     Selsize : Longint;
  154.     FDragCopy : Boolean;
  155.     FSelected : TDirItem;
  156.     FSelection: TFileList;
  157.     FLocked : Boolean;
  158.     DragJustEnded: Boolean;
  159.     Stretching: Boolean;
  160.     Corner, Anchor: TPoint;
  161.     Narrow : Boolean;
  162.     ShowingSelection : Boolean;
  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 GridDrawSmall(Sender: TObject; Index: Integer;
  175.       Rect: TRect; State: TGridDrawState);
  176.     procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND;
  177.     procedure WMNCRButtonDown(var Msg: TWMNCRButtonDown); message WM_NCRBUTTONDOWN;
  178.     procedure WMActivate(var Msg : TWMActivate); message WM_ACTIVATE;
  179.     procedure DrawLasso(r: TRect);
  180.     procedure SelectFileHandler(Sender : TObject;
  181.       const FileSpec : string; select : Boolean);
  182.     procedure SearchFileHandler(Sender : TObject; const s: string);
  183.     procedure InitTopLeft;
  184.     procedure AssignCaption;
  185.   protected
  186.     { Protected declarations }
  187.   public
  188.     { Public declarations }
  189.     constructor Init(AOwner: TComponent;
  190.       const foldername, filter: TFilename);
  191.     procedure DropInFolder(const foldername: TFilename);
  192.     procedure DropInWindow(d : TDirectory);
  193.     procedure DropAsAliases(const foldername : TFilename);
  194.     procedure FolderRenamed(const previous, current: TFilename);
  195.     function FileAt(x, y : Integer; wholecell: Boolean) : TDirItem;
  196.     function CompileSelection(recurse: Boolean): TFileList;
  197.     function CompileFilenames: TStringList;
  198.     procedure ChangeDir(const foldername : string);
  199.     function LoadDimensions: Boolean;
  200.     procedure SaveDimensions;
  201.     procedure Configure;
  202.     procedure SettingsChanged(Changes : TSettingChanges); override;
  203.     procedure RefreshWin;
  204.     procedure UpdateStatusbar(TotalChanged, SelChanged: Boolean);
  205.     procedure CopyToClipboard;
  206.     procedure GotoItem(const filename: string);
  207.     class function CalcSize(cols, rows : Integer): TPoint;
  208.     class procedure CalcColWidths;
  209.  
  210.     property Dir : TDirectory read FDir;
  211.     property Selected : TDirItem read FSelected write FSelected;
  212.     property Selection: TFileList read FSelection;
  213.     property DragCopy: Boolean read FDragCopy write SetDragCopy;
  214.     property Locked : Boolean read FLocked write FLocked;
  215.   end;
  216.  
  217. const
  218.    MacroDisplayMode : Integer = 0;
  219.  
  220. var
  221.    Xspare, YSpare: Integer;
  222.    NameColWidth, SizeColWidth, DateColWidth,
  223.    TimeColWidth, AttrColWidth : Integer;
  224.    SampleDate, SampleTime : string[31];
  225.  
  226. implementation
  227.  
  228. {$R *.DFM}
  229.  
  230. uses ShellAPI, FileProp, DiskProp, Drives, Graphics, Tree, Environs,
  231.   Fileman, WasteBin, FileCtrl, OpenFile, RunProg, Desk, FileFind,
  232.   Filter, CompSys, Strings, MiscUtil, Files, WinProcs, Alias, FSysProp, Select,
  233.   Clipbrd, Referenc, Locale, Embed, Iconic, Task, IncSrch, FourDOS;
  234.  
  235.  
  236. var
  237.   PathMenu : TPopupMenu;
  238.   LastPath : TFilename;
  239.  
  240. const
  241.   LabelTop : Integer = 4;
  242.   LabelDiv : Integer = 153;
  243.  
  244.  
  245. procedure TIconWindow.FormCreate(Sender: TObject);
  246. begin
  247.   Icon.Assign(FolderIcon);
  248.   DeleteMenu(GetSystemMenu(Handle, False), SC_SIZE, MF_BYCOMMAND);
  249.   FSelection := TFileList.Create;
  250.   SelLabel.Left := LabelDiv;
  251. end;
  252.  
  253.  
  254. procedure TIconWindow.FormDestroy(Sender: TObject);
  255. begin
  256.   Desktop.RemoveWindow(self);
  257.   Dir.Free;
  258.   FSelection.Free;
  259.   if WindowOpen = woSaved then SaveDimensions;
  260. end;
  261.  
  262.  
  263. function TIconWindow.LoadDimensions: Boolean;
  264. var
  265.   l, t, w, h: Integer;
  266.   s: string[31];
  267. begin
  268.   { Loads positions and size from INI file }
  269.   s := WindowPos.Values[Dir.Fullname];
  270.   if s = '' then Result := False
  271.   else try
  272.     Result := Unformat(s, '%d,%d,%d,%d', [@l, @t, @w, @h]) = 4;
  273.     if Result then begin
  274.       SetBounds(l, t, w, h);
  275.       Locked := True;
  276.     end;
  277.   except
  278.     on EConvertError do;
  279.   end;
  280. end;
  281.  
  282.  
  283. procedure TIconWindow.SaveDimensions;
  284. begin
  285.   WindowPos.Values[Dir.Fullname] :=
  286.     Format('%d,%d,%d,%d', [Left, Top, Width, Height]);
  287. end;
  288.  
  289.  
  290.  
  291.  
  292. procedure TIconWindow.Configure;
  293. begin
  294.   Color := Colors[ccWinFrame];
  295.  
  296.   with Grid do begin
  297.     Visible := False;
  298.     Color := Colors[ccIconBack];
  299.     SelColor := Colors[ccIconSel];
  300.     ThumbTrack := TrackThumb;
  301.  
  302.     if ViewList.Checked then begin
  303.       DefaultColWidth := Width;
  304.       DefaultRowHeight := LineHeight;
  305.       OnDrawCell := GridDrawList;
  306.     end
  307.     else if SmallIcons.Checked then begin
  308.       DefaultColWidth := NameColWidth + 24;
  309.       DefaultRowHeight := LineHeight;
  310.       OnDrawCell := GridDrawSmall;
  311.     end
  312.     else begin
  313.       DefaultColWidth := BrowseGrid.X;
  314.       DefaultRowHeight := BrowseGrid.Y;
  315.     end;
  316.  
  317.     Font.Assign(GlobalFont);
  318.     Canvas.Font.Assign(Font);
  319.     Visible := True;
  320.   end;
  321.  
  322.   with CalcSize(2, 1) do begin
  323.     MinimumWidth := X;
  324.     MinimumHeight := Y;
  325.   end;
  326. end;
  327.  
  328.  
  329. class procedure TIconWindow.CalcColWidths;
  330. begin
  331.   with Computer.Canvas do begin
  332.     NameColWidth := TextWidth('nnnnnnnn.nnn') + ColumnPadding;
  333.     SizeColWidth := TextWidth('9999.99MB') + ColumnPadding;
  334.     DateColWidth := TextWidth(SampleDate) + ColumnPadding;
  335.     TimeColWidth := TextWidth(SampleTime) + ColumnPadding;
  336.     AttrColWidth := TextWidth('arh') + ColumnPadding;
  337.   end;
  338. end;
  339.  
  340. constructor TIconWindow.Init(AOwner: TComponent;
  341.   const foldername, filter: TFilename);
  342. begin
  343.   inherited Create(AOwner);
  344.  
  345.   { Icon windows always show a directory when opened, so a special
  346.     constructor is needed to ensure that a directory name is used. }
  347.  
  348.   FDir := TDirectory.Create(Makepath(foldername));
  349.   FDir.Filter := filter;
  350.   FDir.Scan;
  351.   FDir.OnUpdate := Arrange;
  352.  
  353.   AssignCaption;
  354.   Desktop.AddWindow(self);
  355.  
  356.   if MacroDisplayMode <> 0 then begin
  357.     SetMenuCheck([LargeIcons, SmallIcons, ViewList], MacroDisplayMode-1);
  358.     MacroDisplayMode := 0;
  359.   end
  360.   else
  361.     SetMenuCheck([LargeIcons, SmallIcons, ViewList], Integer(DefaultDisplay));
  362.  
  363.   Configure;
  364.  
  365.   SetMenuCheck([SortByType, SortByName, SortBySize, SortByDate],
  366.     Integer(Dir.SortOrder));
  367.  
  368.   if not Locked then AutoResize;
  369.   Arrange(self);
  370.  
  371.   InitTopLeft;
  372. end;
  373.  
  374.  
  375. procedure TIconWindow.InitTopLeft;
  376. begin
  377.   if WindowOpen = woRandom then
  378.     SetBounds(Random(Screen.Width - Width - 2),
  379.       Random(Screen.Height - Height - 62),
  380.       Width, Height)
  381.  
  382.   else if not ((WindowOpen = woSaved) and LoadDimensions) then begin
  383.     if Screen.ActiveForm is TIconWindow then begin
  384.       Top := Screen.ActiveForm.Top + 32;
  385.       Left := Screen.ActiveForm.Left + 32;
  386.     end
  387.     else begin
  388.        Top := (Screen.Height - Height) div 2;
  389.        Left := (Screen.Width - Width) div 2;
  390.     end;
  391.   end;
  392. end;
  393.  
  394.  
  395. procedure TIconWindow.ConstructPathMenu;
  396. var
  397.   s: TFilename;
  398.   m: TMenuItem;
  399.   i: Integer;
  400. begin
  401.   { Fills a popup menu with the list of ancestor directories. }
  402.  
  403.   s := ExtractFileDir(Dir.Fullname);
  404.   if LastPath = s then Exit;
  405.  
  406.   with PathMenu.Items do
  407.     while Count > 0 do Items[0].Free;
  408.  
  409.   while Length(s) >= 3 do begin
  410.     m := TMenuItem.Create(PathMenu);
  411.     m.Caption := s;
  412.     m.OnClick := Desktop.WindowSelect;
  413.     PathMenu.Items.Add(m);
  414.     if Length(s) = 3 then s := ''
  415.     else s := ExtractFileDir(s);
  416.   end;
  417. end;
  418.  
  419.  
  420. class function TIconWindow.CalcSize(cols, rows : Integer): TPoint;
  421. begin
  422.   Result.x := cols * BrowseGrid.X + XSpare;
  423.   Result.y := rows * BrowseGrid.Y + YSpare;
  424. end;
  425.  
  426.  
  427. function GridDimensions(N: Integer) : TPoint;
  428. var i: Integer;
  429. begin
  430.   Result.X := 5;
  431.   Result.Y := 4;
  432.  
  433.   if N >= Layouts[NumLayouts-1].Upper then
  434.     Result := Layouts[NumLayouts-1].Size;
  435.  
  436.   for i := 0 to NumLayouts-1 do
  437.     with Layouts[i] do
  438.     if (N >= Lower) and (N <= Upper) then begin
  439.       Result := Size;
  440.       Exit;
  441.     end;
  442. end;
  443.  
  444.  
  445.  
  446. procedure TIconWindow.AutoResize;
  447. var
  448.   size, cells: TPoint;
  449.   details : TFileDetails;
  450. begin
  451.   { Changes the size of the window depending on the number of icons
  452.     in the list }
  453.  
  454.   if WindowState <> wsNormal then Exit;
  455.  
  456.   cells := GridDimensions(Dir.Count);
  457.   size := CalcSize(cells.X, cells.Y);
  458.  
  459.   if ViewList.Checked then begin
  460.     details := Dir.Columns;
  461.     size.x := 22 + NameColWidth + XSpare;
  462.     if fdSize in details then Inc(size.x, SizeColWidth);
  463.     if fdDate in details then Inc(size.x, DateColWidth);
  464.     if fdTime in details then Inc(size.x, TimeColWidth);
  465.     if fdAttr in details then Inc(size.x, AttrColWidth);
  466.     if UseDescriptions and (fdDesc in details) then
  467.       if DescWidth > -1 then Inc(size.x, DescWidth)
  468.       else Inc(size.x, (15 * BrowseGrid.X) div 10);
  469.   end
  470.   else if SmallIcons.Checked then
  471.     size.x := (24 + NameColWidth) * Max(2, cells.x - 2) + XSpare;
  472.  
  473.  
  474.   { The OnResize event is only triggered when the bounds change, but
  475.     as a convention, AutoResize needs to call Resize exactly once
  476.     to reset some of the controls }
  477.  
  478.   if EqualRect(BoundsRect, Bounds(Left, Top, size.X, size.Y)) then Resize
  479.   else SetBounds(Left, Top, size.X, size.Y);
  480. end;
  481.  
  482.  
  483. procedure TIconWindow.Arrange(Sender : TObject);
  484. begin
  485.   { Called after a directory's contents have changed }
  486.  
  487.   if not (csDestroying in ComponentState) then begin
  488.     UpdateStatusbar(True, False);
  489.     Selsize := 0;
  490.  
  491.     with Grid, Dir do begin
  492.       Reset;                 { clear the grid }
  493.       Limit := Count;        { set the selection extent }
  494.       SizeGrid;              { adjust the rows and columns to fit }
  495.  
  496.       { The focus might be out of bounds after files have been deleted }
  497.       if (Focus >= Count) and (Count > 0) then Focus := Count-1;
  498.       GridSelect(self, Focus);
  499.     end;
  500.   end;
  501. end;
  502.  
  503.  
  504. procedure TIconWindow.FormResize(Sender: TObject);
  505. var
  506.   GridBottom : Integer;
  507.   NowNarrow : Boolean;
  508.   NewWidth : Integer;
  509. begin
  510.   if WindowState <> wsMinimized then begin
  511.     Grid.SetBounds(4, 4, ClientWidth - 8, ClientHeight - 26);
  512.     TotalLabel.Top := Grid.Top + Grid.Height + LabelTop;
  513.     SelLabel.Top := TotalLabel.Top;
  514.  
  515.     NowNarrow := (LabelDiv * 2 > ClientWidth) or SingleStatus;
  516.     if Narrow <> NowNarrow then begin
  517.       Narrow := NowNarrow;
  518.       if Narrow then UpdateStatusbar(True, False)
  519.       else UpdateStatusbar(True, True);
  520.     end;
  521.     SelLabel.Visible := not Narrow;
  522.  
  523.     if ViewList.Checked then NewWidth := Width - 2
  524.     else if SmallIcons.Checked then NewWidth := NameColWidth + 24
  525.     else NewWidth := BrowseGrid.X;
  526.  
  527.     { TCustomGrid doesn't compare the current column width with a new
  528.       setting, so DefaultColWidth should be assigned only when required }
  529.  
  530.     with Grid do
  531.       if DefaultColWidth <> NewWidth then DefaultColWidth := NewWidth;
  532.  
  533.     Grid.SizeGrid;
  534.     Invalidate;
  535.   end;
  536. end;
  537.  
  538.  
  539.  
  540. procedure TIconWindow.FormPaint(Sender: TObject);
  541. var
  542.   r: TRect;
  543.   x, y: Integer;
  544. begin
  545.   Border3D(Canvas, ClientWidth-1, ClientHeight-1);
  546.   if Narrow then
  547.     r := Rect(4, ClientHeight - 19, ClientWidth - 3, ClientHeight - 3)
  548.   else begin
  549.     r := Bounds(4, ClientHeight - 19, LabelDiv - 13, 16);
  550.     RecessBevel(Canvas, R);
  551.     r.Left := r.Right + 3;
  552.     r.Right := ClientWidth - 3;
  553.   end;
  554.   RecessBevel(Canvas, R);
  555.  
  556.   { Draw the resize "grip" }
  557.   Canvas.Draw(ClientWidth-17, ClientHeight-17, Sizebox);
  558. end;
  559.  
  560.  
  561. function TIconWindow.FileAt(x, y : Integer; WholeCell: Boolean) : TDirItem;
  562. var
  563.   rect : TRect;
  564.   i : Integer;
  565. begin
  566.   { Returns the item at the given mouse coordinates (grid coordinate system).
  567.     If WholeCell is true, the entire grid box tested for containment,
  568.     otherwise only the icon area (approximately) is tested }
  569.  
  570.   i := Grid.MouseToCell(x, y);
  571.   rect := Grid.CellBounds(i);
  572.  
  573.   if not (ViewList.Checked or SmallIcons.Checked or WholeCell) then begin
  574.     InflateRect(rect, -16, -8);
  575.     OffsetRect(rect, 0, -8);
  576.   end;
  577.  
  578.   if PtInRect(rect, Point(x, y)) and (i < Dir.Count) then
  579.     Result := TDirItem(Dir[i])
  580.   else Result := nil;
  581. end;
  582.  
  583.  
  584.  
  585. procedure TIconWindow.GridDragOver(Sender, Source: TObject; X, Y: Integer;
  586.   State: TDragState; var Accept: Boolean);
  587. var
  588.   f: TDirItem;
  589.   DropInIcon : Boolean;
  590.   NewDrop : Integer;
  591. begin
  592.   { Scroll the grid if the cursor is floating over the vertical
  593.     scroll bar's buttons }
  594.  
  595.   with Grid do
  596.     if (X > Width - 24) and (VisibleRowCount < RowCount) then begin
  597.       if (Y < 32) and (TopRow > 0) then
  598.         TopRow := TopRow-1
  599.       else if (Y > Height-32) and (TopRow < RowCount-VisibleRowCount) then
  600.         TopRow := TopRow+1;
  601.     end;
  602.  
  603.   if Source = Computer.Grid then Accept := False
  604.   else begin
  605.     { This bit is tricky...when the cursor is over a suitable icon,
  606.       the focus box is turned on.  However, when it is not over a suitable
  607.       icon, Accept can still be True because the drop target becomes
  608.       the window.  That is, Accept and DropInIcon are independent }
  609.  
  610.     f := FileAt(X, Y, False);
  611.     DropInIcon := (f <> nil) and f.AcceptsDrops;
  612.     NewDrop := Grid.MouseToCell(X, Y);
  613.     Accept := (Source <> Sender) or ((NewDrop <> Grid.Focus) and DropInIcon);
  614.  
  615.     with Grid do
  616.       if not (Accept and DropInIcon) or (State = dsDragLeave) then
  617.         DropFocus := -1
  618.       else
  619.         DropFocus := NewDrop;
  620.   end;
  621. end;
  622.  
  623.  
  624. procedure TIconWindow.GridDragDrop(Sender, Source: TObject; X, Y: Integer);
  625. var
  626.   target : TDirItem;
  627.   w : TIconWindow;
  628. begin
  629.   Grid.DropFocus := -1;
  630.   target := FileAt(X, Y, False);
  631.  
  632.   if (target <> nil) and target.AcceptsDrops then
  633.     target.DragDrop(Source)
  634.  
  635.   else if Source is TMultiGrid then begin
  636.     w := (TMultiGrid(Source).Owner as TIconWindow);
  637.     if GetAsyncKeyState(VK_SHIFT) < 0 then w.DropAsAliases(Dir.Fullname)
  638.     else w.DropInWindow(Dir)
  639.   end
  640.  
  641.   else if Source = Bin.Listbox then
  642.     Bin.RestoreTo(Dir.Fullname)
  643.  
  644.   else if Source = FindList then
  645.     ProcessFiles(FindForm.CompileSelection, Dir.Fullname);
  646. end;
  647.  
  648.  
  649. procedure TIconWindow.InitFileOp(Op : TFileOperation);
  650. begin
  651.   { Begings a file operation by initialising the progress display,
  652.     cursor and file manager }
  653.  
  654.   Desktop.SetCursor(crBusyPointer);
  655.   CompileSelection(True);
  656.   NoToAll;
  657.  
  658.   ProgressBox.Init(Op, Selection.FileCount);
  659.  
  660.   if UseDescriptions and Simul4DOS then
  661.     Dir.Desc.LoadFromPath(Dir.Path);
  662. end;
  663.  
  664.  
  665. procedure TIconWindow.DoneFileOp;
  666. begin
  667.   ProgressBox.Hide;
  668.   Desktop.ReleaseCursor;
  669.   Desktop.RefreshNow;
  670.   PlaySound(Sounds.Values['NotifyCompletion']);
  671.   if Application.Active then SetFocus;
  672.   NoToAll;
  673. end;
  674.  
  675.  
  676.  
  677. function TIconWindow.InitCopy(const dest : string): Boolean;
  678. begin
  679.   Result := not (ConfirmCopyStart and
  680.     (MsgDialogResFmt(SQueryCopyItems,
  681.        [Grid.SelCount, OneItem[Grid.SelCount = 1], Dir.Fullname, dest],
  682.        mtConfirmation, [mbYes, mbNo], 0) <> mrYes));
  683.  
  684.   if Result then InitFileOp(foCopy);
  685. end;
  686.  
  687.  
  688. function TIconWindow.InitMove(const dest: string) : Boolean;
  689. begin
  690.   Result := not (ConfirmMoveStart and
  691.     (MsgDialogResFmt(SQueryMoveItems,
  692.        [Grid.SelCount, OneItem[Grid.SelCount = 1], Dir.Fullname, dest],
  693.        mtConfirmation, [mbYes, mbNo], 0) <> mrYes));
  694.  
  695.   if Result then InitFileOp(foMove);
  696. end;
  697.  
  698.  
  699. function TIconWindow.InitDelete(const dest: string) : Boolean;
  700. begin
  701.   Result := not (ConfirmDelStart and
  702.     (MsgDialogResFmt(SQueryDeleteItems,
  703.       [Grid.Selcount, OneItem[Grid.SelCount = 1], dest],
  704.         mtConfirmation, [mbYes, mbNo], 0) <> mrYes));
  705.  
  706.   if Result then InitFileOp(foDelete);
  707. end;
  708.  
  709.  
  710. procedure TIconWindow.DropInFolder(const foldername : TFilename);
  711. var
  712.   i : Integer;
  713.   path : TFilename;
  714. begin
  715.   { Copies or moves selected items from this window into a
  716.     specified folder.  If the folder is being shown in an icon window,
  717.     DropInWindow should be used instead. }
  718.  
  719.   path := MakePath(foldername);
  720.   if path = Dir.Path then begin
  721.     ErrorMsgRes(SCannotPutToSelf);
  722.     Exit;
  723.   end;
  724.  
  725.   case DragCopy of
  726.     True : if not InitCopy(foldername) then exit;
  727.     False: if not InitMove(foldername) then exit;
  728.   end;
  729.   try
  730.     if DragCopy then
  731.       for i := 0 to Selection.count-1 do TDirItem(Selection[i]).CopyToPath(path)
  732.     else
  733.       for i := 0 to Selection.Count-1 do TDirItem(Selection[i]).MoveToPath(path);
  734.   finally
  735.     if not DragCopy then Dir.Flush;
  736.     DoneFileOp;
  737.   end;
  738. end;
  739.  
  740.  
  741. procedure TIconWindow.DropInWindow(d : TDirectory);
  742. var i: Integer;
  743. begin
  744.   { Copies or moves selected items from this window into another window,
  745.     represented by its directory object }
  746.  
  747.   if d = Dir then begin
  748.     ErrorMsgRes(SCannotPutToSelf);
  749.     exit;
  750.   end;
  751.  
  752.   if UseDescriptions and Simul4DOS then
  753.     d.Desc.LoadFromPath(d.Path);
  754.  
  755.   case DragCopy of
  756.     True : if not InitCopy(d.Fullname) then exit;
  757.     False: if not InitMove(d.Fullname) then exit;
  758.   end;
  759.  
  760.   try
  761.     if DragCopy then
  762.        for i := 0 to Selection.count-1 do TDirItem(Selection[i]).CopyToDirectory(d)
  763.     else
  764.        for i := 0 to Selection.count-1 do TDirItem(Selection[i]).MoveToDirectory(d);
  765.   finally
  766.     if not DragCopy then Dir.Flush;
  767.     d.Flush;
  768.     DoneFileOp;
  769.   end;
  770. end;
  771.  
  772.  
  773.  
  774. procedure TIconWindow.ObjectMenuPopup(Sender: TObject);
  775. var
  776.   valid : Boolean;
  777.   IsFile : Boolean;
  778. begin
  779.   { Hide inappropriate menu items, depending on the currently
  780.     "focused" object.  }
  781.  
  782.   valid := Selected <> nil;
  783.   IsFile := Selected is TFileItem;
  784.  
  785.   Describe.Visible := UseDescriptions;
  786.   Open.Visible := valid;
  787.   OpenWith.Visible := IsFile;
  788.   Inspect.Visible := IsFile and (InspectProg > '');
  789.   Duplicate.Visible := Selected is TFile;
  790.   AliasProp.Visible := Selected is TAlias;
  791.   Properties.Visible := valid;
  792.   Rename.Visible := valid;
  793.   Delete.Visible := valid;
  794. end;
  795.  
  796.  
  797. procedure TIconWindow.OpenClick(Sender: TObject);
  798. begin
  799.   if Selected <> nil then Selected.Open;
  800. end;
  801.  
  802.  
  803. procedure TIconWindow.DeleteClick(Sender: TObject);
  804. var i : Integer;
  805. begin
  806.   if DeleteToBin and not ((BinAction = baDelete) or (GetAsyncKeyState(VK_SHIFT) < 0)
  807.      or (dfRemoveable in GetDriveFlags(Dir.Path[1]))) then begin
  808.     Bin.FormDragDrop(Bin, Grid, 1, 1);
  809.     Exit;
  810.   end;
  811.  
  812.   if (Grid.SelCount > 0) and InitDelete(Dir.Fullname) then
  813.   try
  814.     for i := 0 to Selection.Count-1 do TDirItem(Selection[i]).Delete;
  815.   finally
  816.     Dir.Flush;
  817.     DoneFileOp;
  818.   end;
  819. end;
  820.  
  821.  
  822. procedure TIconWindow.CreateFolderClick(Sender: TObject);
  823. var s: TFilename;
  824. begin
  825.   s := '';
  826.   if InputQuery(LoadStr(SCreateFolder), LoadStr(SNewFolderName), s) then
  827.     Dir.CreateFolder(Lowercase(s));
  828. end;
  829.  
  830.  
  831. procedure TIconWindow.DrawLasso(r: TRect);
  832. begin
  833.   { Draw the "column of marching ants" selection box, like the
  834.     one used in Delphi's form editor.  PolyLine must be used for
  835.     this effect -- MoveTo and LineTo don't work }
  836.  
  837.   with Grid.Canvas do begin
  838.     Pen.Style := psDot;
  839.     Pen.Mode := pmXor;
  840.     PolyLine([Point(r.Left, r.Top), Point(r.Right, r.Top),
  841.       Point(r.Right, r.Bottom), Point(r.Left, r.Bottom),
  842.       Point(r.Left, r.Top)]);
  843.   end;
  844. end;
  845.  
  846.  
  847. procedure TIconWindow.GridMouseDown(Sender: TObject; Button: TMouseButton;
  848.   Shift: TShiftState; X, Y: Integer);
  849. var
  850.   p : TPoint;
  851.   r : TRect;
  852. begin
  853.   if not (ssDouble in Shift) then begin
  854.  
  855.     if Button = mbLeft then begin
  856.       if (FileAt(X, Y, False) <> nil) and (Grid.SelCount > 0) then with Grid do begin
  857.         { Start dragging when clicking over an icon }
  858.         DragCopy := DefDragCopy xor (ssAlt in Shift);
  859.         BeginDrag(False);
  860.       end
  861.       else with Grid do begin
  862.         { Start lasso selection when clicking over empty space }
  863.         Stretching := True;
  864.         Update;
  865.         Anchor := Point(X, Y);
  866.         Corner := Anchor;
  867.         with ClientRect do begin
  868.           r.TopLeft := ClientToScreen(TopLeft);
  869.           r.BottomRight := ClientToScreen(Bottomright);
  870.           ClipCursor(@r);
  871.         end;
  872.       end;
  873.     end
  874.  
  875.     else if Grid.Dragging then
  876.       { Toggle move/copy when right clicking during file drag }
  877.       DragCopy := not DragCopy
  878.  
  879.     else if not Stretching then with Grid do begin
  880.       { Display appropriate context menu }
  881.       GetCursorPos(p);
  882.       if FileAt(X, Y, False) = nil then
  883.         WinMenu.Popup(p.x, p.y)
  884.       else begin
  885.         AllowMulti := False;
  886.         Select(MouseToCell(X, Y));
  887.         AllowMulti := True;
  888.         if SelCount > 0 then begin
  889.           if ssAlt in Shift then Properties.Click
  890.           else if ssCtrl in Shift then OpenWith.Click
  891.           else if ssShift in Shift then Inspect.Click
  892.           else ObjectMenu.Popup(p.x, p.y);
  893.         end;
  894.       end;
  895.     end;
  896.   end;
  897. end;
  898.  
  899.  
  900. procedure TIconWindow.FormDragOver(Sender, Source: TObject; X, Y: Integer;
  901.   State: TDragState; var Accept: Boolean);
  902. begin
  903.   Accept := (Source <> Grid) and (Source <> Computer.Grid);
  904. end;
  905.  
  906.  
  907. procedure TIconWindow.OpenWithClick(Sender: TObject);
  908. var s: TFilename;
  909. begin
  910.   if not (Selected is TFileItem) then exit;
  911.   ShowHourGlass;
  912.   s := TOpenFileDlg.Execute;
  913.   if s > '' then OpenFileWith(Selected.Fullname, s);
  914. end;
  915.  
  916.  
  917. procedure TIconWindow.PropertiesClick(Sender: TObject);
  918. begin
  919.   if Grid.SelCount > 0 then begin
  920.     ShowHourglass;
  921.     with TFilePropDlg.Create(Application) do
  922.     try
  923.       if Grid.Selcount = 1 then SetItem(Selected)
  924.       else SetItem(CompileSelection(True));
  925.       ShowModal;
  926.     finally
  927.       Free;
  928.     end;
  929.   end;
  930. end;
  931.  
  932.  
  933. procedure TIconWindow.GridCellSelected(Sender: TObject; Index : Integer;
  934.   IsSelected: Boolean);
  935. var s: Longint;
  936. begin
  937.   { Called once for each selection or deselection in the grid.  If the
  938.     user selects 100 files in one go, this is called 100 times, so keep
  939.     the code short }
  940.  
  941.   if Index < Dir.Count then begin
  942.     s := TDirItem(Dir[Index]).Size;
  943.     if IsSelected then Inc(Selsize, s) else Dec(Selsize, s);
  944.   end;
  945. end;
  946.  
  947.  
  948. procedure TIconWindow.RenameClick(Sender: TObject);
  949. var s: TFilename;
  950. begin
  951.   if Selected <> nil then with Selected do begin
  952.     s := Filename;
  953.     if InputQuery(FmtLoadStr(SRename, [Filename]), LoadStr(SNewFilename), s) then begin
  954.       if UseDescriptions and Simul4DOS then
  955.         Dir.Desc.LoadFromPath(Dir.Path);
  956.       Filename := Lowercase(s);
  957.       Dir.Update;
  958.     end;
  959.   end;
  960. end;
  961.  
  962.  
  963. procedure TIconWindow.GridKeyPress(Sender: TObject; var Key: Char);
  964. var
  965.   c: Char;
  966.   i, foc: Integer;
  967.   found : Boolean;
  968. begin
  969.   case Key of
  970.    { optimized Case statement in ascending order of ASCII value }
  971.  
  972.    ' ': with Grid do
  973.           if Focus < Dir.Count then begin
  974.             Selected[Focus] := not Selected[Focus];
  975.             UpdateStatusbar(False, True);
  976.           end;
  977.    '*': Desktop.CloseOtherWindows(self);
  978.    '+': Desktop.CloseLowerWindows(Dir.Fullname);
  979.    '-': Desktop.ClosePathWindows(Dir.Fullname);
  980.    '.': with TIncSearchDlg.Create(Application) do
  981.         try
  982.           OnSearch := SearchFileHandler;
  983.           ShowModal;
  984.         finally
  985.           Free;
  986.         end;
  987.    '/': Desktop.CloseWindows;
  988.    '?': SetFilter.Click;
  989.    'D': SortByDate.Click;
  990.    'I': LargeIcons.Click;
  991.    'L': ViewList.Click;
  992.    'M': SmallIcons.Click;
  993.    'N': SortByName.Click;
  994.    'S': SortBySize.Click;
  995.    'T': SortByType.Click;
  996.    '\': Desktop.OpenFolder(Dir.Path[1] + ':\');
  997.  
  998.   else if not (Key in Uppers) then
  999.     { Jump to the next object which begins with this character }
  1000.  
  1001.     with Dir do if Count > 1 then begin
  1002.       c := LowCase(Key);
  1003.       foc := Grid.Focus;
  1004.       i := (foc + 1) mod Count;
  1005.  
  1006.       while (i <> foc) and (LowCase(TDirItem(List^[i]).GetTitle[1]) <> c) do
  1007.         i := (i + 1) mod Count;
  1008.  
  1009.       if i <> foc then Grid.Select(i);
  1010.     end;
  1011.   end;
  1012. end;
  1013.  
  1014.  
  1015. procedure TIconWindow.FormDragDrop(Sender, Source: TObject; X, Y: Integer);
  1016. begin
  1017.   if Source is TMultiGrid then
  1018.     TIconWindow(TMultiGrid(Source).Owner).DropInWindow(Dir)
  1019.  
  1020.   else if Source = Bin.Listbox then
  1021.     Bin.RestoreTo(Dir.Fullname)
  1022.  
  1023.   else if Source = FindList then
  1024.     ProcessFiles(FindForm.CompileSelection, Dir.Fullname);
  1025. end;
  1026.  
  1027.  
  1028. procedure TIconWindow.RefreshWin;
  1029. begin
  1030.   try
  1031.     Dir.Scan;
  1032.     if not Locked then AutoResize;
  1033.     Arrange(self);
  1034.   except
  1035.     on EScanError do Close;
  1036.   end;
  1037. end;
  1038.  
  1039.  
  1040. procedure TIconWindow.RunClick(Sender: TObject);
  1041. begin
  1042.   if Selected <> nil then RunExecute(Selected.Filename, Dir.Fullname)
  1043.   else RunExecute('', Dir.Fullname);
  1044. end;
  1045.  
  1046.  
  1047. procedure TIconWindow.DropAsAliases(const foldername : TFilename);
  1048. var
  1049.   i: Integer;
  1050. begin
  1051.   ShowHourGlass;
  1052.   for i := 0 to Dir.Count-1 do
  1053.     if Grid.Selected[i] then
  1054.       with TDirItem(Dir[i]) do
  1055.         WriteAlias(MakePath(foldername) +
  1056.           ChangeFileExt(Filename, AliasExtension));
  1057. end;
  1058.  
  1059.  
  1060. procedure TIconWindow.SetFilterClick(Sender: TObject);
  1061. begin
  1062.   ShowHourglass;
  1063.   with TFilterDialog.Create(Application) do
  1064.   try
  1065.     if Execute(Dir) = mrOK then RefreshWin;
  1066.   finally
  1067.     Free;
  1068.   end;
  1069. end;
  1070.  
  1071.  
  1072. procedure TIconWindow.SortByTypeClick(Sender: TObject);
  1073. var item: TDirItem;
  1074. begin
  1075.   { Handles all "sorting" menu item events }
  1076.   with Sender as TMenuItem do
  1077.     if not Checked then begin
  1078.       { save focused item }
  1079.       item := nil;
  1080.       if Grid.Focus < Dir.Count then item := TDirItem(Dir.Items[Grid.Focus]);
  1081.  
  1082.       SetMenuCheck([SortByType, SortByName, SortBySize, SortByDate], Tag);
  1083.       Dir.SortOrder := TSortOrder(Tag);
  1084.       Dir.Sort;
  1085.       if item <> nil then Grid.Focus := Dir.IndexOf(item);
  1086.       Dir.Update;
  1087.       RefreshCursor;
  1088.     end;
  1089. end;
  1090.  
  1091.  
  1092. function TIconWindow.CompileSelection(recurse: Boolean): TFileList;
  1093. var i: Integer;
  1094. begin
  1095.   { Fills a TFileList with the current selection.  Recurse controls
  1096.     whether subdirectories have their content sizes counted.  Use
  1097.     this instead of the TDirectory object when items may be moved
  1098.     or deleted }
  1099.  
  1100.   Desktop.SetCursor(crHourGlass);
  1101.   with Selection do begin
  1102.     Clear;
  1103.     Capacity := max(Capacity, Grid.SelCount);
  1104.     Selection.DeepScan := recurse;
  1105.     for i := 0 to Dir.Count-1 do
  1106.       if Grid.Selected[i] then Selection.Add(Dir[i]);
  1107.   end;
  1108.   Desktop.ReleaseCursor;
  1109.   Result := Selection;
  1110. end;
  1111.  
  1112.  
  1113. procedure TIconWindow.GridKeyDown(Sender: TObject; var Key: Word;
  1114.   Shift: TShiftState);
  1115. var
  1116.   item : TMenuItem;
  1117.   s: TFilename;
  1118.   p: PChar;
  1119. begin
  1120.   { The grid can only have one PopupMenu property, so the window menu
  1121.     is searched manually for a shortcut match }
  1122.   s := '';
  1123.   item := WinMenu.FindItem(Shortcut(Key, Shift), fkShortcut);
  1124.  
  1125.   if item <> nil then item.Click
  1126.   else begin
  1127.     { Handle keyboard commands not in menus }
  1128.  
  1129.     if (Key = VK_BACK) and (Shift + [ssAlt] = [ssAlt]) then begin
  1130.       if Length(Dir.Path) > 3 then
  1131.         Desktop.OpenFolder(ExtractFileDir(Dir.Fullname))
  1132.       else
  1133.         Computer.ShowNormal;
  1134.     end
  1135.  
  1136.     else if (Shift = [ssCtrl, ssShift]) and (Chr(Key) in ValidDrives) then
  1137.       { Ctrl+Alt+Letter opens the root directory }
  1138.       Desktop.OpenFolder(LowCase(Chr(Key)) + ':\')
  1139.  
  1140.     else if Shift = [ssCtrl] then
  1141.       case key of
  1142.         Ord('A'): with Grid do
  1143.                     if SelCount = Dir.Count then DeselectAll else SelectAll;
  1144.  
  1145.         Ord('C'): CopyToClipboard;
  1146.         Ord('E'): OpenExplorer(Dir.Fullname);
  1147.         Ord('P'): begin
  1148.                     if Selected <> nil then s := Selected.Fullname;
  1149.                     if InputQuery(LoadStr(SPrintFile), LoadStr(SFilename), s) then
  1150.                       PrintFile(s);
  1151.                   end;
  1152.         Ord('O'): Computer.ExecuteMacro(self, '$Folder', '');
  1153.         Ord('S'): with TSelectFileDlg.Create(Application) do
  1154.                   try
  1155.                     OnSelectFiles := SelectFileHandler;
  1156.                     ShowModal;
  1157.                   finally
  1158.                     Free;
  1159.                   end;
  1160.         Ord('U'): DefaultExec(UndeleteProg, '', Dir.Fullname, SW_SHOW);
  1161.         VK_F5   : Desktop.Cascade;
  1162.       end
  1163.  
  1164.     else if (Shift = [ssShift]) then
  1165.       case key of
  1166.         VK_DELETE : Delete.Click;
  1167.         VK_F5     : Desktop.ArrangeIcons
  1168.       end
  1169.  
  1170.     else if Shift = [] then
  1171.       case Key of
  1172.         VK_F3   : FileFindExecute(Dir.Fullname);
  1173.         VK_F5   : RefreshWin;
  1174.         VK_F12  : Application.Minimize;
  1175.       end;
  1176.   end;
  1177. end;
  1178.  
  1179.  
  1180. procedure TIconWindow.WMSysCommand(var Msg: TWMSysCommand);
  1181. begin
  1182.   inherited;
  1183.   with Sounds do case Msg.CmdType and $FFF0 of
  1184.     SC_MINIMIZE: PlaySound(Values['WindowMinimize']);
  1185.     SC_MAXIMIZE: PlaySound(Values['WindowMaximize']);
  1186.     SC_CLOSE   : PlaySound(Values['WindowClose']);
  1187.     SC_RESTORE : PlaySound(Values['WindowRestore']);
  1188.   end;
  1189. end;
  1190.  
  1191.  
  1192. procedure TIconWindow.FormShow(Sender: TObject);
  1193. begin
  1194.   PlaySound(Sounds.Values['WindowOpen']);
  1195.   if IconWindowTask then Taskbar.AddButton(Handle);
  1196. end;
  1197.  
  1198.  
  1199. procedure TIconWindow.DuplicateClick(Sender: TObject);
  1200. var s: string;
  1201. begin
  1202.    if not (Selected is TFileItem) then exit;
  1203.  
  1204.    s := '';
  1205.    if InputQuery(FmtLoadStr(SDuplicateFile, [Selected.Filename]),
  1206.       LoadStr(SNewFilename), s) then begin
  1207.      (Selected as TFileItem).Duplicate(Lowercase(s));
  1208.      Dir.Update;
  1209.    end;
  1210. end;
  1211.  
  1212.  
  1213. procedure TIconWindow.GridDrawCell(Sender: TObject; Index: Integer;
  1214.   Rect: TRect; State: TGridDrawState);
  1215. begin
  1216.   TDirItem(Dir[Index]).Draw(Grid.Canvas, Rect);
  1217. end;
  1218.  
  1219. procedure TIconWindow.GridDrawSmall(Sender: TObject; Index: Integer;
  1220.   Rect: TRect; State: TGridDrawState);
  1221. begin
  1222.   TDirItem(Dir[Index]).DrawSmall(Grid.Canvas, Rect);
  1223. end;
  1224.  
  1225.  
  1226. procedure TIconWindow.GridDrawList(Sender: TObject; Index: Integer;
  1227.   Rect: TRect; State: TGridDrawState);
  1228. begin
  1229.   TDirItem(Dir[Index]).DrawAsList(Grid.Canvas, Rect)
  1230. end;
  1231.  
  1232.  
  1233. procedure TIconWindow.GridSelectCell(Sender: TObject; Index: Integer;
  1234.   var CanSelect: Boolean);
  1235. begin
  1236.   CanSelect := not Stretching;
  1237. end;
  1238.  
  1239.  
  1240. procedure TIconWindow.DropServerFileDrop(Sender: TObject; X, Y: Integer;
  1241.   Target: Word);
  1242. var i: Integer;
  1243. begin
  1244.   with DropServer.Files do begin
  1245.     if Grid.SelCount > 0 then
  1246.       for i := 0 to Dir.Count-1 do
  1247.         if Grid.Selected[i] then Add(TDirItem(Dir[i]).Fullname);
  1248.  
  1249.     if IsPrintManager(Target) and (Count > 0) then begin
  1250.       PrintFile(Strings[0]);
  1251.       Clear;
  1252.     end;
  1253.   end;
  1254. end;
  1255.  
  1256.  
  1257. procedure TIconWindow.TotalLabelMouseDown(Sender: TObject;
  1258.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  1259. begin
  1260.   if ssShift in Shift then SelLabelMouseDown(self, Button, Shift, X, Y)
  1261.   else if Button = mbRight then DiskPropExecute(Upcase(Dir.Path[1]));
  1262. end;
  1263.  
  1264.  
  1265. procedure TIconWindow.GridMouseUp(Sender: TObject; Button: TMouseButton;
  1266.   Shift: TShiftState; X, Y: Integer);
  1267. var
  1268.   r, s: TRect;
  1269.   i, count, topitem: Integer;
  1270. begin
  1271.   if Button <> mbLeft then exit;
  1272.   ClipCursor(nil);
  1273.  
  1274.   with Grid do begin
  1275.     count := Grid.SelCount;
  1276.  
  1277.     if Stretching then begin
  1278.       { Select files inside lasso }
  1279.       Stretching := False;
  1280.       R := NormalizeRect(Anchor, Corner);
  1281.       DrawLasso(R);
  1282.       topitem := Toprow * ColCount;
  1283.       for i := topitem to Min(Dir.Count,
  1284.        topitem + (VisibleColCount * (VisibleRowCount+1)))-1 do begin
  1285.  
  1286.         s := CellBounds(i);
  1287.         InflateRect(s, -16, -8);
  1288.         if Intersects(R, S) then Selected[i] := True;
  1289.       end;
  1290.     end;
  1291.  
  1292.     { Deselect when the user clicks in an empty area, provided that
  1293.       no new files were selected and a drag hasn't just finished }
  1294.  
  1295.     if (count = SelCount) and not DragJustEnded and
  1296.       (FileAt(X, Y, True) = nil) and (Dir.Count > 0) then
  1297.       DeselectAll;
  1298.  
  1299.     GridSelect(self, Focus);
  1300.   end;
  1301.   DragJustEnded := False;
  1302. end;
  1303.  
  1304.  
  1305. procedure TIconWindow.GridEndDrag(Sender, Target: TObject; X, Y: Integer);
  1306. begin
  1307.   DragJustEnded := True;
  1308.   DropServer.DragFinished;
  1309. end;
  1310.  
  1311.  
  1312. procedure TIconWindow.SelLabelMouseDown(Sender: TObject;
  1313.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  1314. var
  1315.   i: Integer;
  1316.   k: Word;
  1317. begin
  1318.   if Button = mbLeft then with Grid do
  1319.     if ssCtrl in Shift then begin
  1320.       for i := 0 to Dir.Count-1 do Selected[i] := not Selected[i];
  1321.       UpdateStatusbar(False, True);
  1322.     end
  1323.     else
  1324.       if SelCount = 0 then SelectAll
  1325.       else DeselectAll
  1326.  
  1327.   else if Button = mbRight then begin
  1328.     { fake a Ctrl+S shortcut }
  1329.     k := Ord('S');
  1330.     GridKeyDown(Grid, k, [ssCtrl]);
  1331.   end;
  1332. end;
  1333.  
  1334.  
  1335. procedure TIconWindow.GridMouseMove(Sender: TObject; Shift: TShiftState; X,
  1336.   Y: Integer);
  1337. begin
  1338.  if Grid.Dragging then begin
  1339.     if DropServer.CanDrop and AnimCursor then
  1340.       SetCursor(Screen.Cursors[crFlutter]);
  1341.  end
  1342.  else if Stretching then begin
  1343.     { erase previous lasso and redraw }
  1344.     DrawLasso(NormalizeRect(Anchor, Corner));
  1345.     Corner := Point(X, Y);
  1346.     DrawLasso(NormalizeRect(Anchor, Corner));
  1347.   end;
  1348. end;
  1349.  
  1350.  
  1351. procedure TIconWindow.DropClientDropFiles(Sender: TObject);
  1352. var target : TDirItem;
  1353. begin
  1354.   with DropClient do
  1355.   if (WindowState <> wsMinimized) and PtInRect(Grid.BoundsRect, DropPos) then begin
  1356.  
  1357.     target := FileAt(DropPos.x, DropPos.y, False);
  1358.  
  1359.     if (target <> nil) and target.AcceptsDrops then
  1360.       target.DragDrop(Files)
  1361.     else
  1362.       ProcessFiles(Files, Dir.Fullname)
  1363.   end
  1364.   else ProcessFiles(Files, Dir.Fullname)
  1365. end;
  1366.  
  1367.  
  1368. procedure TIconWindow.FolderRenamed(const previous, current: TFilename);
  1369. var s: TFilename;
  1370. begin
  1371.   { Search for the ancestor which has been renamed and change that
  1372.     part of the string to the new name }
  1373.  
  1374.   s := Dir.Fullname;
  1375.   if (previous = s) or IsAncestorDir(previous, s) then begin
  1376.     System.Delete(s, 1, Length(previous));
  1377.     Desktop.RemoveWindow(self);
  1378.     Dir.Path := current + s + '\';
  1379.     AssignCaption;
  1380.     Desktop.AddWindow(self);
  1381.   end;
  1382. end;
  1383.  
  1384.  
  1385. procedure TIconWindow.DropServerDeskDrop(Sender: TObject; X, Y: Integer;
  1386.   Target: Word);
  1387. begin
  1388.   if Selected <> nil then
  1389.     Selected.CreateShortcut.MinPosition := Point(X - 16, Y - 16);
  1390. end;
  1391.  
  1392.  
  1393. procedure TIconWindow.WMNCRButtonDown(var Msg: TWMNCRButtonDown);
  1394. begin
  1395.   inherited;
  1396.   with Msg do
  1397.     if HitTest = HTSYSMENU then begin
  1398.       ConstructPathMenu;
  1399.       PathMenu.Popup(XCursor, YCursor);
  1400.     end;
  1401. end;
  1402.  
  1403.  
  1404. function TIconWindow.CompileFilenames: TStringList;
  1405. var i: Integer;
  1406. begin
  1407.   { Just returns a new list of filenames.  Compare CompileSelection method }
  1408.   Result := TStringList.Create;
  1409.   for i := 0 to Dir.Count-1 do
  1410.     if Grid.Selected[i] then Result.Add(TDirItem(Dir[i]).Fullname);
  1411. end;
  1412.  
  1413.  
  1414. procedure TIconWindow.SetDragCopy(copy: Boolean);
  1415. const
  1416.   DragCursors : array[Boolean, Boolean] of TCursor =
  1417.     ( (crDropFile, crDropMulti), (crDropCopy, crDropMultiCopy ));
  1418. begin
  1419.   { Sets the cursor shape depending on whether copy mode is on, and
  1420.     how many items are selected }
  1421.  
  1422.   FDragCopy := copy;
  1423.   with Grid do DragCursor := DragCursors[FDragCopy, SelCount > 1];
  1424.   RefreshCursor;
  1425. end;
  1426.  
  1427.  
  1428. procedure TIconWindow.FormDblClick(Sender: TObject);
  1429. const
  1430.   NewStates : array[TWindowState] of TWindowState =
  1431.     (wsMaximized, wsMinimized, wsNormal);
  1432. begin
  1433.   WindowState := NewStates[WindowState];
  1434. end;
  1435.  
  1436.  
  1437. procedure TIconWindow.GridSelect(Sender: TObject; Index: Integer);
  1438. begin
  1439.   { Called whenever the selection has changed }
  1440.  
  1441.   if (index < Dir.Count) and (Grid.SelCount > 0) then
  1442.     Selected := TDirItem(Dir[index])
  1443.   else begin
  1444.     Selected := nil;
  1445.     if Dir.Count = 0 then Grid.Focus := 0;
  1446.   end;
  1447.  
  1448.   UpdateStatusBar(False, True);
  1449. end;
  1450.  
  1451.  
  1452. procedure TIconWindow.InspectClick(Sender: TObject);
  1453. begin
  1454.   if (Selected is TFileItem) and (InspectProg > '') then
  1455.     OpenFileWith(Selected.Fullname, InspectProg);
  1456. end;
  1457.  
  1458.  
  1459. procedure TIconWindow.ChangeDir(const foldername : string);
  1460. begin
  1461.   if foldername = Dir.Fullname then exit;
  1462.   Desktop.RemoveWindow(self);
  1463.   Dir.Path := MakePath(foldername);
  1464.   AssignCaption;
  1465.   Desktop.AddWindow(self);
  1466.   RefreshWin;
  1467.   with Grid do begin
  1468.     if TopRow > 0 then begin
  1469.       Update;
  1470.       TopRow := 0;
  1471.     end;
  1472.     Focus := 0;
  1473.   end;
  1474. end;
  1475.  
  1476.  
  1477. procedure TIconWindow.ViewListClick(Sender: TObject);
  1478. begin
  1479.   with Sender as TMenuItem do
  1480.     if not Checked then
  1481.       SetMenuCheck([LargeIcons, SmallIcons, ViewList], Tag);
  1482.  
  1483.   with Grid do begin
  1484.     Visible := False;
  1485.     if ViewList.Checked then begin
  1486.       DefaultRowHeight := LineHeight;
  1487.       OnDrawCell := GridDrawList;
  1488.     end
  1489.     else if SmallIcons.Checked then begin
  1490.       DefaultRowHeight := LineHeight;
  1491.       OnDrawCell := GridDrawSmall;
  1492.     end
  1493.     else begin
  1494.       DefaultRowHeight := BrowseGrid.Y;
  1495.       OnDrawCell := GridDrawCell;
  1496.     end;
  1497.  
  1498.     if not Locked and (WindowState = wsNormal) then AutoResize
  1499.     else Resize;
  1500.     Visible := True;
  1501.     SetFocus;
  1502.   end;
  1503. end;
  1504.  
  1505.  
  1506. procedure TIconWindow.FormMouseDown(Sender: TObject; Button: TMouseButton;
  1507.   Shift: TShiftState; X, Y: Integer);
  1508. var p: TPoint;
  1509. begin
  1510.   if Button = mbRight then begin
  1511.     GetCursorPos(p);
  1512.     WinMenu.Popup(p.X, p.Y);
  1513.   end;
  1514. end;
  1515.  
  1516.  
  1517. procedure TIconWindow.AliasPropClick(Sender: TObject);
  1518. begin
  1519.   if Selected is TAlias then TAlias(Selected).Edit;
  1520. end;
  1521.  
  1522.  
  1523. procedure TIconWindow.WMActivate(var Msg : TWMActivate);
  1524. begin
  1525.   inherited;
  1526.   if Msg.Active = WA_INACTIVE then Application.HintPause := NormalHintPause
  1527.   else Application.HintPause := HintDelay;
  1528. end;
  1529.  
  1530.  
  1531. procedure TIconWindow.FormHide(Sender: TObject);
  1532. begin
  1533.   if IconWindowTask then Taskbar.DeleteButton(Handle);
  1534. end;
  1535.  
  1536.  
  1537. procedure TIconWindow.DescribeClick(Sender: TObject);
  1538. var i: Integer;
  1539. begin
  1540.   if Grid.Selcount = 0 then Exit;
  1541.  
  1542.   if UseDescriptions and Simul4DOS then
  1543.     Dir.Desc.LoadFromPath(Dir.Path);
  1544.  
  1545.   ShowHourglass;
  1546.   CompileSelection(False);
  1547.   for i := 0 to Selection.count-1 do
  1548.     if not TDirItem(Selection[i]).EditDescription then Break;
  1549.  
  1550.   Dir.Desc.SaveToPath(Dir.Path);
  1551.   Grid.Invalidate;
  1552. end;
  1553.  
  1554.  
  1555. procedure TIconWindow.FileSystemClick(Sender: TObject);
  1556. begin
  1557.   ShowModalDialog(TFileSysPropDlg);
  1558. end;
  1559.  
  1560. procedure TIconWindow.SettingsChanged(Changes: TSettingChanges);
  1561. begin
  1562.   if [scSystem, scFileSystem, scDesktop, scDisplay] * Changes <> [] then
  1563.     Configure;
  1564.   if sc4DOS in Changes then RefreshWin;
  1565. end;
  1566.  
  1567.  
  1568. procedure TIconWindow.SelectFileHandler(Sender : TObject;
  1569.   const FileSpec : string; select : Boolean);
  1570. var i: Integer;
  1571. begin
  1572.   for i := 0 to Dir.Count-1 do
  1573.     if WildCardMatch(TDirItem(Dir[i]).Filename, FileSpec) then
  1574.       Grid.Selected[i] := select;
  1575.   GridSelect(self, Grid.Focus);
  1576. end;
  1577.  
  1578.  
  1579.  
  1580. procedure TIconWindow.GridDblClick(Sender: TObject);
  1581. begin
  1582.   if (GetAsyncKeyState(VK_SHIFT) < 0) and (Selected is TFolder) then
  1583.     OpenExplorer(Selected.Fullname)
  1584.   else
  1585.     Open.Click;
  1586. end;
  1587.  
  1588. procedure TIconWindow.FormClose(Sender: TObject; var Action: TCloseAction);
  1589. begin
  1590.   Action := caFree;
  1591. end;
  1592.  
  1593.  
  1594. function MakeValidFilename(const s: TFilename): TFilename;
  1595. var i: Integer;
  1596. begin
  1597.   Result := '';
  1598.   for i := 1 to Length(s) do
  1599.     if not (s[i] in InvalidFilenameChars) then
  1600.       AppendStr(Result, s[i]);
  1601. end;
  1602.  
  1603.  
  1604. procedure TIconWindow.NewAliasClick(Sender: TObject);
  1605. const
  1606.   NewAliasKind : array[Boolean] of TReferenceKind =
  1607.     (rkFile, rkInternet);
  1608. var
  1609.   s: TFilename;
  1610.   Icon : TIcon;
  1611.   R : TReference;
  1612. begin
  1613.   ShowHourglass;
  1614.   R := TAliasReference.Create;
  1615.   with R do
  1616.   try
  1617.     Kind := NewAliasKind[Computer.BrowserLink.IsBrowserLoaded];
  1618.  
  1619.     if AssignFromExternal then begin
  1620.       s := MangleFilename(Dir.Path,
  1621.         MakeValidFilename(Copy(Caption, 1, 8)) + AliasExtension);
  1622.       if (ConfirmNewAlias or not (dfWriteable in GetDriveFlags(s[1]))) and
  1623.         not InputQuery(LoadStr(SCreateAlias), LoadStr(SAliasFilename), s) then Exit;
  1624.  
  1625.       Icon := TIcon.Create;
  1626.       try
  1627.         AssignIcon(Icon);
  1628.         TAlias.Store(s, R, Icon);
  1629.         Desktop.UpdateFileWindow(s);
  1630.       finally
  1631.         Icon.Free;
  1632.       end;
  1633.     end
  1634.   finally
  1635.     Free;
  1636.   end;
  1637. end;
  1638.  
  1639.  
  1640. procedure TIconWindow.UpdateStatusbar(TotalChanged, SelChanged: Boolean);
  1641. const
  1642.   Labels : array[Boolean] of string[23] = (SSSelectedItems, SSSelectedOneItem);
  1643. begin
  1644.   ShowingSelection := False;
  1645.  
  1646.   if (SelChanged and Narrow and (Grid.SelCount = 0)) or TotalChanged then
  1647.     TotalLabel.Caption :=
  1648.       Format(SSNumObjects,
  1649.         [Dir.Count, OneItem[Dir.Count = 1], FormatByte(Dir.Size, 2)]);
  1650.  
  1651.   if SelChanged then
  1652.     if Narrow and (Grid.SelCount > 0) then begin
  1653.       TotalLabel.Caption := Format(Labels[Grid.SelCount = 1],
  1654.         [Grid.SelCount, FormatByte(Selsize, 2)]);
  1655.       ShowingSelection := True;
  1656.     end
  1657.     else
  1658.       SelLabel.Caption := Format(Labels[Grid.SelCount = 1],
  1659.       [Grid.SelCount, FormatByte(Selsize, 2)]);
  1660. end;
  1661.  
  1662.  
  1663. procedure TIconWindow.TotalLabelClick(Sender: TObject);
  1664. begin
  1665.   if GetAsyncKeyState(VK_SHIFT) >= 0 then RefreshWin;
  1666. end;
  1667.  
  1668. procedure TIconWindow.WinMenuPopup(Sender: TObject);
  1669. begin
  1670.   SetFilter.Checked := Dir.Filter <> DefaultFilter;
  1671. end;
  1672.  
  1673. procedure TIconWindow.CopyToClipboard;
  1674. var
  1675.   strings: TStrings;
  1676.   i : Integer;
  1677.   s : string;
  1678.   details : TFileDetails;
  1679.   item : TDirItem;
  1680. begin
  1681.   if Grid.SelCount = 0 then
  1682.     Clipboard.AsText := Dir.Path + Dir.Filter
  1683.  
  1684.   else begin
  1685.     strings := TStringList.Create;
  1686.     try
  1687.       strings.Add(LoadStr(SDirectoryOf) + Dir.Fullname);
  1688.  
  1689.       if not ViewList.Checked then begin
  1690.         for i := 0 to Dir.Count-1 do
  1691.           if Grid.Selected[i] then
  1692.             strings.Add(TDirItem(Dir[i]).GetTitle)
  1693.       end
  1694.  
  1695.       else begin
  1696.         details := Dir.Columns;
  1697.  
  1698.         for i := 0 to Dir.Count-1 do
  1699.           if Grid.Selected[i] then begin
  1700.             item := TDirItem(Dir[i]);
  1701.  
  1702.             s := Format('%-12s', [item.Filename]);
  1703.  
  1704.             if fdSize in details then begin
  1705.               if item is TFolder then
  1706.                 AppendStr(s, ' <DIR>     ')
  1707.               else
  1708.                 AppendStr(s, Format(' %10s',
  1709.                   [FormatByte(item.Size, ListKBDecimals)]));
  1710.             end;
  1711.  
  1712.             if fdDate in details then
  1713.               AppendStr(s, Format(' %*s',
  1714.                 [Length(SampleDate), DateToStr(item.TimeStamp)]));
  1715.  
  1716.             if fdTime in details then
  1717.               AppendStr(s,Format(' %*s',
  1718.                 [Length(SampleTime), ShortTimeToStr(item.TimeStamp)]));
  1719.  
  1720.             if fdAttr in details then
  1721.               AppendStr(s, Format(' %-4s', [AttrToStr(item.Attr and not faDirectory)]));
  1722.  
  1723.             if UseDescriptions and (fdDesc in details) then
  1724.               AppendStr(s, ' ' + item.Description);
  1725.  
  1726.             strings.Add(s);
  1727.           end;
  1728.       end;
  1729.  
  1730.       CopyStringsToClipboard(strings);
  1731.     finally
  1732.       strings.Free;
  1733.     end;
  1734.   end;
  1735. end;
  1736.  
  1737. procedure TIconWindow.GotoItem(const filename: string);
  1738. var i: Integer;
  1739. begin
  1740.   if Dir.Find(filename, i) then with Grid do begin
  1741.     Select(i);
  1742.     Selected[i] := True;
  1743.   end;
  1744. end;
  1745.  
  1746. procedure TIconWindow.AssignCaption;
  1747. var
  1748.   folder, buf : string[79];
  1749.   des : TDescriptions;
  1750. begin
  1751.   folder := Dir.Fullname;
  1752.   TotalLabel.Hint := folder;
  1753.  
  1754.   buf := GlobalCaptions.Values[folder];
  1755.  
  1756.   if (buf = '') and DescCaptions and (Length(folder) > 3) then begin
  1757.     des := TDescriptions.Create;
  1758.     des.LoadFromPath(ExtractFileDir(folder));
  1759.     buf := des.Get(Extractfilename(folder), nil);
  1760.     des.Free;
  1761.   end;
  1762.  
  1763.   if ShortWinCaptions or (buf > '') then begin
  1764.     if buf = '' then begin
  1765.       if Length(folder) = 3 then
  1766.         buf := MakeDriveName(GuessDriveType(Dir.Path[1]), Dir.Path[1])
  1767.       else begin
  1768.         buf := ExtractFilename(folder);
  1769.         if UpcaseFirstChar then buf[1] := Upcase(buf[1]);
  1770.       end;
  1771.     end;
  1772.     Caption := buf;
  1773.   end
  1774.   else
  1775.     Caption := folder;
  1776. end;
  1777.  
  1778. procedure TIconWindow.SearchFileHandler(Sender : TObject; const s: string);
  1779. var
  1780.   i: Integer;
  1781.   cap : string[31];
  1782.   found : Boolean;
  1783. begin
  1784.   if s = '' then Exit;
  1785.  
  1786.   for i := 0 to Dir.Count-1 do begin
  1787.     if LargeIcons.Checked then cap := TDirItem(Dir[i]).GetTitle
  1788.     else cap := TDirItem(Dir[i]).Filename;
  1789.  
  1790.     if s[Length(s)] = ' ' then
  1791.       found := CompareText(Copy(s, 1, Length(s)-1), cap) = 0
  1792.     else
  1793.       found := Pos(s, Lowercase(cap)) = 1;
  1794.  
  1795.     if found then begin
  1796.       GotoItem(TDirItem(Dir[i]).Filename);
  1797.       Exit;
  1798.     end;
  1799.   end;
  1800. end;
  1801.  
  1802.  
  1803.  
  1804. initialization
  1805.   PathMenu := TPopupMenu.Create(Application);
  1806.   Xspare := GetSystemMetrics(SM_CYVSCROLL) + 13;
  1807.   Yspare := GetSystemMetrics(SM_CYCAPTION) + 29;
  1808.   SampleDate := DateToStr(EncodeDate(1997, 12, 12));
  1809.   SampleTime := ShortTimeToStr(EncodeTime(12, 0, 0, 0));
  1810.  
  1811.   if Screen.PixelsPerInch > 96 then begin
  1812.     LabelTop := 2;
  1813.     LabelDiv := 170;
  1814.   end;
  1815. end.
  1816.