home *** CD-ROM | disk | FTP | other *** search
/ PC Open 19 / pcopen19.iso / Zipped / CALMIR21.ZIP / SOURCE.ZIP / SRC / ICONIC.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-02-20  |  7.4 KB  |  258 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 Iconic;
  24.  
  25. interface
  26.  
  27. uses WinTypes, SysUtils, Graphics, FileCtrl, Referenc, Shorts, Embed;
  28.  
  29. type
  30.  
  31. TSmallStr = string[15];
  32.  
  33. { TIconic is the base class for all objects which are shown as
  34.   icons in a window.  This includes disk drives, files, folders
  35.   and aliases.
  36.  
  37.     FName - a string to hold a short caption or filename
  38.     FIcon - a pointer which descandants should maintain themselves.
  39.  
  40.     Draw - provides a simple way to display the object by drawing
  41.       the icon with the caption underneath.  Descandants override
  42.       this for more complex drawing.
  43.  
  44.     InternalDraw - does the actual drawing (called by Draw).
  45.  
  46.     Open - abstract method that determines what happens when you
  47.       double click on the object
  48.  
  49.     AssignRef - abstract method that fills the fields of a
  50.       TReference object with information about the TIconic object
  51.  
  52.     CreateShortcut - returns a new shortcut to the object.
  53.       This uses AssignRef so it must be called from descandants.
  54.  
  55.     WriteAlias - creates and alias file for the object, and
  56.       if necessary, updates the window which should display the
  57.       alias.
  58. }
  59.  
  60. TIconic = class
  61. protected
  62.   FIcon : TIcon;
  63.   procedure InternalDraw(Canvas: TCanvas; const Rect: TRect; const Text: string);
  64. public
  65.   procedure Draw(Canvas: TCanvas; const Rect: TRect); virtual; abstract;
  66.   procedure Open; virtual; abstract;
  67.   procedure AssignRef(ref: TReference); virtual; abstract;
  68.   function CreateShortcut : TShort;
  69.   procedure WriteAlias(filename : TFilename);
  70.   property Icon: TIcon read FIcon write FIcon;
  71. end;
  72.  
  73. { TDrive represents a disk drive in the system window.
  74.   TProgram represents a Windows program in the system window.
  75.   Their functionality is minimal. }
  76.  
  77. const
  78.   DefaultDriveNames : array[TDriveType] of string[15] =
  79.     (SSUnknownDrive, SSNoDrive, SSFloppyDrive, SSFixedDrive,
  80.      SSNetworkDrive, SSCDROMDrive, SSRamDrive);
  81.  
  82. type
  83.  
  84. TShortCaption = string[31];
  85.  
  86. TComputerIcon = class(TIconic)
  87. private
  88.   FCaption : TShortCaption;
  89. public
  90.   procedure Draw(Canvas: TCanvas; const Rect: TRect); override;
  91.   property Caption: TShortCaption read FCaption write FCaption;
  92. end;
  93.  
  94. TDrive = class(TComputerIcon)
  95. private
  96.   FLetter : Char;
  97.   FDriveType : TDriveType;
  98. public
  99.   constructor Create(ADrive : Char);
  100.   procedure Open; override;
  101.   procedure AssignRef(ref: TReference); override;
  102.   function Root : TFilename;
  103.   property Letter: Char read FLetter;
  104. end;
  105.  
  106.  
  107. TProgram = class(TComputerIcon)
  108. private
  109.   FFilename : TFilename;
  110. public
  111.   property Filename : TFilename read FFilename;
  112.   constructor Create(const progname: TFilename);
  113.   destructor Destroy; override;
  114.   procedure AssignRef(ref: TReference); override;
  115.   procedure Open; override;
  116. end;
  117.  
  118. function MakeDriveName(DriveType: TDriveType; Letter: Char): string;
  119.  
  120. implementation
  121.  
  122. uses Classes, Drives, Resource, Desk, WinProcs, ShellAPI, Forms, Settings,
  123.   Alias, Strings, Files, Dialogs, Controls, Streamer, IconWin, MiscUtil, Locale;
  124.  
  125. procedure TComputerIcon.Draw(Canvas: TCanvas; const Rect: TRect);
  126. begin
  127.   InternalDraw(Canvas, Rect, Caption);
  128. end;
  129.  
  130.  
  131. procedure TIconic.InternalDraw(Canvas: TCanvas;
  132.   const Rect: TRect; const Text: string);
  133. var
  134.   w, tw, iconleft: Integer;
  135.   r : TRect;
  136. begin
  137.   with Canvas, Rect do begin
  138.     Font.Color := clWindowText;
  139.     w := Right - Left;
  140.     Draw(Left + ((w - 32) div 2), Top+1, FIcon);
  141.  
  142.     tw := TextWidth(Text);
  143.  
  144.     if tw > w then begin
  145.       r := Rect;
  146.       Inc(r.Top, 33);
  147.       DrawText(Handle, @Text[1], Ord(Text[0]), r,
  148.         DT_CENTER or DT_WORDBREAK or DT_NOCLIP or DT_NOPREFIX)
  149.     end
  150.     else
  151.       TextOut(Left + ((w - tw) div 2), Top + 33, Text);
  152.   end;
  153. end;
  154.  
  155.  
  156. function TIconic.CreateShortcut : TShort;
  157. begin
  158.   Result := TShort.Create(Application);
  159.   AssignRef(Result.Ref);
  160. end;
  161.  
  162.  
  163. procedure TIconic.WriteAlias(filename : TFilename);
  164. var
  165.   Reference : TReference;
  166. begin
  167.   if (ConfirmNewAlias or not (dfWriteable in GetDriveFlags(filename[1]))) and
  168.     not InputQuery(LoadStr(SCreateAlias), LoadStr(SAliasFilename), filename) then Abort;
  169.  
  170.   if FFileExists(filename) and (MsgDialogResFmt(SQueryReplaceAlias,
  171.     [filename], mtInformation, [mbYes, mbNo], 0) <> mrYes) then Abort;
  172.  
  173.   Reference := TReference.Create;
  174.   try
  175.     AssignRef(Reference);
  176.     TAlias.Store(filename, Reference, Icon);
  177.     Desktop.UpdateFileWindow(filename);
  178.   finally
  179.     Reference.Free;
  180.   end;
  181. end;
  182.  
  183.  
  184.  
  185. function MakeDriveName(DriveType: TDriveType; Letter: Char): string;
  186. var
  187.   fmt : string[31];
  188. begin
  189.   Letter := Upcase(Letter);
  190.   fmt := GlobalCaptions{DriveNames}.Values[Letter];
  191.   if fmt > '' then
  192.     Result := Format(fmt, [Letter])
  193.   else
  194.     Result := Format(DefaultDriveNames[DriveType], [Letter]);
  195. end;
  196.  
  197.  
  198. constructor TDrive.Create(ADrive : Char);
  199. begin
  200.   inherited Create;
  201.   FLetter := Lowcase(ADrive);
  202.   FDriveType := GuessDriveType(FLetter);
  203.   FCaption := MakeDriveName(FDriveType, FLetter);
  204.   Icon := icons.Drive[FDriveType];
  205. end;
  206.  
  207.  
  208. function TDrive.Root: TFilename;
  209. begin
  210.   Result := Letter + ':\';
  211. end;
  212.  
  213. procedure TDrive.Open;
  214. begin
  215.    Desktop.OpenFolder(Root);
  216. end;
  217.  
  218.  
  219. procedure TDrive.AssignRef(ref: TReference);
  220. begin
  221.   with Ref do begin
  222.     Kind := rkDrive;
  223.     Target := Root;
  224.     Caption := FCaption;
  225.   end;
  226. end;
  227.  
  228.  
  229. constructor TProgram.Create(const progname: TFilename);
  230. begin
  231.   FFilename := progname;
  232.   FCaption := ExtractFilename(FFilename);
  233.   Icon := TIcon.Create;
  234.   Icon.Handle := ExtractIcon(HInstance, StringAsPChar(FFilename), 0);
  235. end;
  236.  
  237. destructor TProgram.Destroy;
  238. begin
  239.   Icon.Free;
  240.   inherited Destroy;
  241. end;
  242.  
  243.  
  244. procedure TProgram.Open;
  245. begin
  246.   WinExec(StringAsPChar(FFilename), SW_SHOW);
  247. end;
  248.  
  249.  
  250. procedure TProgram.AssignRef(ref: TReference);
  251. begin
  252.   ref.Kind := rkFile;
  253.   ref.Target := FFilename;
  254.   ref.Caption := Caption;
  255. end;
  256.  
  257. end.
  258.