home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1998 April A / Pcwk4a98.iso / PROGRAM / DELPHI16 / Calmira / Src / SRC / REFERENC.PAS < prev    next >
Pascal/Delphi Source File  |  1997-02-15  |  14KB  |  479 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 Referenc;
  24.  
  25. { TReference is a class used to unify shortcuts and aliases.
  26.   Each shortcut and alias contains a reference object, which points
  27.   to a file, folder or disk drive, and handles most of the action.
  28.  
  29.   There are 5 string properties, which require a lot of memory,
  30.   so instead of using 5 string fields, each property maps to
  31.   a function which assigns and maintains a dynamic string.
  32.   Empty strings don't take up any memory.
  33.  
  34.   BeginUpdate, EndUpdate - ensures that the OnChange event is
  35.     not triggered while the fields are being modified.
  36.  
  37.   Edit - creates a property dialog to edit the reference, executes
  38.     it and returns the result of the edit, either mrOK or mrCancel.
  39.  
  40.   LoadFromStream, SaveToStream - this uses a TStreamer object to
  41.     read and write the reference.
  42.  
  43.   Reference objects do not maintain icons themselves, but have
  44.   an AssignIcon function that sets a TIcon to a suitable image that
  45.   reflects the object.
  46. }
  47.  
  48.  
  49. interface
  50.  
  51. uses Classes, Graphics, SysUtils, IniFiles, Forms, Streamer;
  52.  
  53. type
  54.  
  55. TReferenceKind = (rkDrive, rkFolder, rkFile);
  56.  
  57. TReference = class
  58. private
  59.   FKind : TReferenceKind;
  60.   FShowMode : Integer;
  61.   FUseDocFolder : Boolean;
  62.   FIconIndex : Integer;
  63.   FOnChange : TNotifyEvent;
  64.   FUpdates : Integer;
  65.   FStringBuf : array[0..4] of PString;
  66.   FLeft, FTop : Integer;
  67.   procedure SetKind(value : TReferenceKind);
  68.   procedure SetStringProp(i: Integer; const s: TFilename);
  69.   function GetStringProp(i: Integer): TFilename;
  70. protected
  71.   procedure Change; virtual;
  72.   procedure SetAsLast;
  73. public
  74.   constructor Create;
  75.   destructor Destroy; override;
  76.   procedure Open;
  77.   procedure DragDrop(Source : TObject);
  78.   procedure AcceptFiles(files : TStrings);
  79.   function Edit: TModalResult;
  80.   procedure AssignIcon(Icon : TIcon);
  81.   procedure BeginUpdate;
  82.   procedure EndUpdate;
  83.   procedure LoadFromStream(s : TStreamer);
  84.   procedure SaveToStream(s : TStreamer);
  85.   procedure LoadFromIni(ini : TIniFile; const section: string);
  86.   procedure SaveToIni(ini : TIniFile; const section: string);
  87.   property Left : Integer read FLeft write FLeft;
  88.   property Top : Integer read FTop write FTop;
  89.   property Kind : TReferenceKind read FKind write FKind;
  90.   property Target : TFilename index 0 read GetStringProp write SetStringProp;
  91.   property Params : TFilename index 1 read GetStringProp write SetStringProp;
  92.   property WorkingFolder : TFilename index 2 read GetStringProp write SetStringProp;
  93.   property ShowMode : Integer read FShowMode write FShowMode;
  94.   property UseDocFolder : Boolean read FUseDocFolder write FUseDocFolder;
  95.   property Caption : TFilename index 3 read GetStringProp write SetStringProp;
  96.   property IconFile : TFilename index 4 read GetStringProp write SetStringProp;
  97.   property IconIndex : Integer read FIconIndex write FIconIndex;
  98.   property OnChange : TNotifyEvent read FOnChange write FOnChange;
  99. end;
  100.  
  101. { The two subclasses are only used to distinguish between shortcuts
  102.   and aliases at run-time }
  103.  
  104. TShortcutReference = class(TReference);
  105. TAliasReference = class(TReference);
  106.  
  107. var
  108.   { Preset references pointing to a drive, folder or file.  These can be
  109.     used freely, but remember that there is no locking mechanism for
  110.     mutual exclusion }
  111.  
  112.   DriveRef, FolderRef, FileRef : TReference;
  113.  
  114.   { The Lastxxxx variables hold information about the most recent program
  115.     executed.  This is used to provide a suitable icon for the taskbar }
  116.  
  117.   LastInstance : Word;
  118.   LastIconFile : TFilename;
  119.   LastIconIndex: Integer;
  120.  
  121.  
  122. implementation
  123.  
  124. uses Controls, IconWin, Desk, Files, RefEdit, Strings, FileFind, MiscUtil,
  125.   WinTypes, ShellAPI, Resource, Drives, WasteBin, FileMan, MultiGrd, Settings,
  126.   FourDOS, TabNotBk, Environs;
  127.  
  128.  
  129. constructor TReference.Create;
  130. var i: Integer;
  131. begin
  132.   inherited Create;
  133.   for i := 0 to High(FStringBuf) do FStringBuf[i] := NullStr;
  134. end;
  135.  
  136. destructor TReference.Destroy;
  137. var i: Integer;
  138. begin
  139.   for i := 0 to High(FStringBuf) do DisposeStr(FStringBuf[i]);
  140.   inherited Destroy;
  141. end;
  142.  
  143.  
  144. procedure TReference.SetStringProp(i: Integer; const s: TFilename);
  145. begin
  146.   if FStringBuf[i]^ <> s then begin
  147.     AssignStr(FStringBuf[i], s);
  148.     if i = 3 then Change;  { caption field }
  149.   end;
  150. end;
  151.  
  152. function TReference.GetStringProp(i: Integer): TFilename;
  153. begin
  154.   Result := FStringBuf[i]^;
  155. end;
  156.  
  157.  
  158. procedure TReference.Open;
  159. begin
  160.   case Kind of
  161.     rkDrive, rkFolder :
  162.       Desktop.OpenFolderRefresh(EnvironSubst(Target));
  163.     rkFile  :
  164.       begin
  165.         SetAsLast;
  166.         LastInstance := DefaultExec(Target, Params, WorkingFolder,
  167.           ShowCmdsEx(ShowMode));
  168.       end;
  169.   end;
  170. end;
  171.  
  172.  
  173. procedure TReference.DragDrop(Source : TObject);
  174. var
  175.   f, win : TIconWindow;
  176.   files: TStringList;
  177. begin
  178.   if Source is TMultiGrid then begin
  179.     win := (Source as TMultiGrid).Owner as TIconWindow;
  180.  
  181.     if Kind in [rkDrive, rkFolder] then begin
  182.       f := Desktop.WindowOf(Target);
  183.       if f = nil then begin
  184.         { Since there is no TDirectory to transfer file descriptions
  185.           to, a separate object must be used to load them }
  186.  
  187.         if UseDescriptions then
  188.           SharedDesc.LoadFromPath(MakePath(Target));
  189.         try
  190.           win.DropInFolder(Target);
  191.         finally
  192.           if UseDescriptions then
  193.             SharedDesc.SaveToPath(MakePath(Target));
  194.         end;
  195.       end
  196.       else win.DropInWindow(f.Dir);
  197.     end
  198.     else begin
  199.       files := win.CompileFilenames;
  200.       try AcceptFiles(files);
  201.       finally files.Free;
  202.       end;
  203.     end;
  204.   end
  205.  
  206.   else if (Source = Bin.Listbox) and (Kind <> rkFile) then
  207.     Bin.RestoreTo(MakeDirname(Target))
  208.  
  209.   else if Source = FindList then
  210.     AcceptFiles(FindForm.CompileSelection)
  211.  
  212.   else if Source is TStrings then
  213.     AcceptFiles(TStrings(Source));
  214. end;
  215.  
  216.  
  217. procedure TReference.AcceptFiles(files : TStrings);
  218. var
  219.   i : Integer;
  220.   d : TFilename;
  221.   p : string;
  222. begin
  223.   if Kind in [rkFolder, rkDrive] then
  224.     { This should only be used to handle file drops from other programs,
  225.       since file descriptions are not updated.  TIconWindow has
  226.       DropInWindow and DropInFolder methods to handle normal file transfer. }
  227.  
  228.     ProcessFiles(files, Target)
  229.  
  230.   else begin
  231.     { Drop files into a program }
  232.  
  233.     p := Params;
  234.  
  235.     if UseDocFolder and (Files.Count > 0) then begin
  236.       { Get rid of the pathnames }
  237.       d := ExtractFileDir(files[0]);
  238.       for i := 0 to files.Count-1 do
  239.         files[i] := ExtractFilename(files[i]);
  240.     end
  241.     else d := WorkingFolder;
  242.  
  243.     { If no drop position is specified, add them to the end of the params }
  244.  
  245.     if Pos('%DROPPEDFILES%', Uppercase(params)) = 0 then
  246.       AppendStr(p, ' %DROPPEDFILES%');
  247.  
  248.     Environment.Values['DROPPEDFILES'] := FileParams(files);
  249.  
  250.     LastInstance := DefaultExec(Target, p, d, ShowCmdsEx(ShowMode));
  251.  
  252.     if LastInstance <= 32 then
  253.       ErrorMsg(Format('Unable to open %s.', [Target]))
  254.     else
  255.       SetAsLast;
  256.  
  257.     Environment.Values['DROPPEDFILES'] := '';
  258.   end;
  259. end;
  260.  
  261.  
  262.  
  263. procedure TReference.AssignIcon(Icon : TIcon);
  264. var
  265.   h: HIcon;
  266.   s : TFilename;
  267.  
  268. procedure AssignDefault;
  269. var ext : string[3];
  270. begin
  271.   s := EnvironSubst(Target);
  272.   case Kind of
  273.     rkDrive  : Icon.Assign(icons.Drive[GuessDriveType(s[1])]);
  274.     rkFolder : Icon.Assign(foldericon);
  275.     rkFile   : begin
  276.                  ext := Copy(ExtractFileExt(s), 2, 3);
  277.                  if ExtensionIn(ext, IconStrings) then begin
  278.                    h := ExtractIcon(HInstance, StringAsPChar(s), 0);
  279.                    if h > 1 then Icon.Handle := h
  280.                    else if ExtensionIn(ext, programs) then
  281.                      case h of
  282.                        0 : Icon.Assign(WindowsIcon);
  283.                        1 : Icon.Assign(DOSIcon);
  284.                      end
  285.                    else
  286.                      Icon.Assign(icons.Get(ext))
  287.                  end
  288.                  else
  289.                    Icon.Assign(icons.Get(ext));
  290.                end;
  291.   end;
  292. end;
  293.  
  294. begin
  295.   if IconFile > '' then begin
  296.     s := EnvironSubst(IconFile);
  297.     h := ExtractIcon(HInstance, StringAsPChar(s), IconIndex);
  298.     if h > 1 then Icon.Handle := h
  299.     else AssignDefault;
  300.   end
  301.   else AssignDefault;
  302. end;
  303.  
  304.  
  305. procedure TReference.BeginUpdate;
  306. begin
  307.   Inc(FUpdates);
  308. end;
  309.  
  310. procedure TReference.EndUpdate;
  311. begin
  312.   if FUpdates > 0 then begin
  313.     Dec(FUpdates);
  314.     if FUpdates = 0 then Change;
  315.   end;
  316. end;
  317.  
  318.  
  319. procedure TReference.SetKind(value : TReferenceKind);
  320. begin
  321.   Kind := value;
  322.   Change;
  323. end;
  324.  
  325.  
  326. procedure TReference.Change;
  327. begin
  328.   if (FUpdates = 0) and Assigned(FOnChange) then FOnChange(self);
  329. end;
  330.  
  331.  
  332. function TReference.Edit: TModalResult;
  333. var buf: TFilename;
  334. begin
  335.   Result := mrCancel;
  336.  
  337.   RefEditDlg := TRefEditDlg.Create(Application);
  338.  
  339.   with RefEditDlg do begin
  340.  
  341.   if self is TAliasReference then Caption := 'Alias Properties'
  342.   else Caption := 'Shortcut Properties';
  343.  
  344.   SetMenuCheck([DriveKind, FolderKind, FileKind], Ord(Kind));
  345.   TargetEdit.Text := Target;
  346.   CapEdit.Text := self.Caption;
  347.   if IconFile > '' then
  348.     IconEdit.Text := Format('%s(%d)', [IconFile, IconIndex]);
  349.  
  350.   if Kind = rkFile then begin
  351.     FilePanel.Enabled := True;
  352.     FilePanel.Font.Color := clBlack;
  353.     ParamEdit.Text := Params;
  354.     FolderEdit.Text := WorkingFolder;
  355.     ShowGroup.ItemIndex := ShowMode;
  356.     DocFolder.Checked := UseDocFolder;
  357.   end;
  358.  
  359.   try
  360.     if ShowModal = mrOK then begin
  361.       Result := mrOK;
  362.       Kind := TReferenceKind(GetMenuCheck([DriveKind, FolderKind, FileKind]));
  363.       Target := TargetEdit.Text;
  364.       self.Caption := CapEdit.Text;
  365.  
  366.       IconFile := ExtractIconFile(IconEdit.Text);
  367.       IconIndex := ExtractIconIndex(IconEdit.Text);
  368.  
  369.       if Kind = rkFile then begin
  370.         Params := ParamEdit.Text;
  371.         WorkingFolder := FolderEdit.Text;
  372.         ShowMode := ShowGroup.ItemIndex;
  373.         UseDocFolder := DocFolder.Checked;
  374.       end;
  375.       Change;
  376.     end;
  377.   finally
  378.     RefEditDlg.Free;
  379.     RefEditDlg := nil;
  380.   end;
  381.   end;
  382. end;
  383.  
  384.  
  385. procedure TReference.SetAsLast;
  386. begin
  387.   LastIconFile := IconFile;
  388.   LastIconIndex := IconIndex;
  389. end;
  390.  
  391.  
  392. procedure TReference.LoadFromStream(s : TStreamer);
  393. begin
  394.   BeginUpdate;
  395.   with s do begin
  396.     FLeft := ReadInteger;
  397.     FTop := ReadInteger;
  398.     Kind := TReferenceKind(ReadInteger);
  399.     Target := ReadString;
  400.     Caption := ReadString;
  401.     IconFile := ReadString;
  402.     IconIndex := ReadInteger;
  403.     Params := ReadString;
  404.     WorkingFolder := ReadString;
  405.     ShowMode := ReadInteger;
  406.     UseDocFolder := ReadBoolean;
  407.   end;
  408.   EndUpdate;
  409. end;
  410.  
  411.  
  412. procedure TReference.SaveToStream(s: TStreamer);
  413. begin
  414.   with s do begin
  415.     WriteInteger(FLeft);
  416.     WriteInteger(FTop);
  417.     WriteInteger(Integer(Kind));
  418.     WriteString(Target);
  419.     WriteString(Caption);
  420.     WriteString(IconFile);
  421.     WriteInteger(IconIndex);
  422.     WriteString(Params);
  423.     WriteString(WorkingFolder);
  424.     WriteInteger(ShowMode);
  425.     WriteBoolean(UseDocFolder);
  426.   end;
  427. end;
  428.  
  429.  
  430. procedure TReference.LoadFromIni(ini : TIniFile; const section: string);
  431. begin
  432.   BeginUpdate;
  433.   with ini do begin
  434.     Kind := TReferenceKind(ini.ReadInteger(section, 'Kind', 0));
  435.     Target := ReadString(section, 'Target', 'c:\');
  436.     Caption := ReadString(section, 'Caption', 'Drive C:');
  437.     IconFile := ReadString(section, 'IconFile', '');
  438.     IconIndex := ReadInteger(section, 'IconIndex', 0);
  439.     Params := ReadString(section, 'Params', '');
  440.     WorkingFolder := ReadString(section, 'WorkingFolder', '');
  441.     ShowMode := ReadInteger(section, 'ShowMode', 0);
  442.     UseDocFolder := ReadBool(section, 'UseDocFolder', True);
  443.  end;
  444.  EndUpdate;
  445. end;
  446.  
  447.  
  448. procedure TReference.SaveToIni(ini : TIniFile; const section: string);
  449. begin
  450.   with ini do begin
  451.     WriteInteger(section, 'Kind', Integer(Kind));
  452.     WriteString(section, 'Target', Target);
  453.     WriteString(section, 'Caption', Caption);
  454.     WriteString(section, 'IconFile', IconFile);
  455.     WriteInteger(section, 'IconIndex', IconIndex);
  456.     WriteString(section, 'Params', Params);
  457.     WriteString(section, 'WorkingFolder', WorkingFolder);
  458.     WriteInteger(section, 'ShowMode', ShowMode);
  459.     WriteBool(section, 'UseDocFolder', UseDocFolder);
  460.   end;
  461. end;
  462.  
  463.  
  464. procedure DoneReference; far;
  465. begin
  466.   FolderRef.Free;
  467.   FileRef.Free;
  468. end;
  469.  
  470. initialization
  471.   AddExitProc(DoneReference);
  472.  
  473.   FolderRef := TReference.Create;
  474.   FolderRef.Kind := rkFolder;
  475.  
  476.   FileRef := TReference.Create;
  477.   FileRef.Kind := rkFile;
  478. end.
  479.