home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1998 April A / Pcwk4a98.iso / PROGRAM / DELPHI16 / Calmira / Src / SRC / SHORTS.PAS < prev    next >
Pascal/Delphi Source File  |  1997-02-15  |  7KB  |  236 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 Shorts;
  24.  
  25. { Shortcuts are implemented as ordinary forms that stay minimized.
  26.   Each shortcut contains a TReference which handles the interaction
  27.   with the main engine.  TDesktop is responsible for loading and
  28.   saving shortcuts }
  29.  
  30. interface
  31.  
  32. uses
  33.   SysUtils, WinTypes, WinProcs, Messages, Classes, Controls,
  34.   Forms, Dialogs, Dropclnt, DragDrop, IniFiles, Referenc, CalForm, CalMsgs,
  35.   Sysmenu, Settings;
  36.  
  37. const
  38.   SC_PROPERTIES = SC_VSCROLL + 99;
  39.  
  40. type
  41.   TShort = class(TCalForm)
  42.     DropClient: TDropClient;
  43.     SystemMenu: TSystemMenu;
  44.     procedure FormDragDrop(Sender, Source: TObject; X, Y: Integer);
  45.     procedure FormDragOver(Sender, Source: TObject; X, Y: Integer;
  46.       State: TDragState; var Accept: Boolean);
  47.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  48.     procedure FormCreate(Sender: TObject);
  49.     procedure DropClientDropFiles(Sender: TObject);
  50.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  51.     procedure FormDestroy(Sender: TObject);
  52.   private
  53.     { Private declarations }
  54.     FRef : TReference;
  55.     LastMouseDown : Longint;
  56.     procedure WMQueryOpen(var Msg: TWMQueryOpen); message WM_QUERYOPEN;
  57.     procedure WMOpenShort(var Msg : TMsg); message WM_OPENSHORT;
  58.     procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND;
  59.     procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
  60.     procedure WMMouseActivate(var Msg : TWMMouseActivate); message WM_MOUSEACTIVATE;
  61.     procedure RefChange(Sender : TObject);
  62.   public
  63.     { Public declarations }
  64.     procedure SettingsChanged(Changes : TSettingChanges); override;
  65.     property Ref : TReference read FRef;
  66.     procedure LoadFromIni(ini : TIniFile; const section:  string);
  67.     procedure SaveToIni(ini : TIniFile; const section : string);
  68.   end;
  69.  
  70.  
  71. implementation
  72.  
  73. {$R *.DFM}
  74.  
  75. uses Desk, Resource, IconWin, ShellAPI, FileMan, MultiGrd, WasteBin,
  76.   FileFind, Drives, Files, Strings, MiscUtil, Sys, Graphics;
  77.  
  78. const QueryClose : Boolean = False;
  79.  
  80. procedure TShort.WMQueryOpen(var Msg: TWMQueryOpen);
  81. begin
  82.   { New windows cannot be opened when inside SendMessage, so
  83.     an extra message must be posted to remind the shortcut to open.
  84.     0 is returned to keep the shortcut iconic }
  85.   Msg.Result := 0;
  86.   PostMessage(Handle, WM_OPENSHORT, 0, 0);
  87. end;
  88.  
  89.  
  90. procedure TShort.WMOpenShort(var Msg : TMsg);
  91. begin
  92.   Ref.Open;
  93. end;
  94.  
  95.  
  96. procedure TShort.WMSysCommand(var Msg: TWMSysCommand);
  97. begin
  98.   if Msg.CmdType = SC_CLOSE then
  99.     QueryClose := True
  100.   else if Msg.CmdType = SC_PROPERTIES then
  101.     Ref.Edit;
  102.  
  103.   inherited;
  104.   QueryClose := False;
  105. end;
  106.  
  107.  
  108. procedure TShort.FormDragDrop(Sender, Source: TObject; X, Y: Integer);
  109. begin
  110.   Ref.DragDrop(Source);
  111. end;
  112.  
  113.  
  114. procedure TShort.FormDragOver(Sender, Source: TObject; X, Y: Integer;
  115.   State: TDragState; var Accept: Boolean);
  116. begin
  117.   Accept := (Source <> SysWindow.Grid) and ((Source <> Bin.Listbox) or
  118.     (Ref.Kind <> rkFile));
  119. end;
  120.  
  121.  
  122. procedure TShort.FormClose(Sender: TObject; var Action: TCloseAction);
  123. begin
  124.   Action := caFree;
  125. end;
  126.  
  127.  
  128. procedure TShort.FormCreate(Sender: TObject);
  129. begin
  130.   with SystemMenu do begin
  131.     Insert(6, 'Properties...', SC_PROPERTIES);
  132.     Rename(SC_RESTORE, 'Open');
  133.     Rename(SC_CLOSE, 'Remove');
  134.     DeleteCommand(SC_SIZE);
  135.     DeleteCommand(SC_MINIMIZE);
  136.     DeleteCommand(SC_MAXIMIZE);
  137.     DeleteCommand(SC_TASKLIST);
  138.     Delete(5);
  139.   end;
  140.  
  141.   FRef := TShortcutReference.Create;
  142.   FRef.OnChange := RefChange;
  143. end;
  144.  
  145.  
  146. procedure TShort.WMPaint(var Msg: TWMPaint);
  147. begin
  148.   inherited;
  149.   if ShortArrows and (WindowState = wsMinimized) then
  150.     Canvas.Draw(0, 22, ShortArrow);
  151. end;
  152.  
  153.  
  154. procedure TShort.DropClientDropFiles(Sender: TObject);
  155. begin
  156.   Ref.AcceptFiles(DropClient.Files);
  157. end;
  158.  
  159.  
  160. procedure TShort.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  161. begin
  162.   { Query close is set to True when the user deletes the shortcut
  163.     from the popup menu.  During shutdown, this is False so shortcuts
  164.     are closed without asking }
  165.  
  166.   CanClose := not QueryClose or not ConfirmDelShort or
  167.     (MsgDialog(Format('Delete shortcut to "%s"?', [Caption]),
  168.       mtConfirmation, mbOKCancel, 0) = mrOK);
  169. end;
  170.  
  171.  
  172. procedure TShort.RefChange(Sender : TObject);
  173. begin
  174.   Ref.AssignIcon(Icon);
  175.   Caption := Ref.Caption;
  176. end;
  177.  
  178.  
  179. procedure TShort.LoadFromIni(ini : TIniFile; const section:  string);
  180. begin
  181.   Ref.LoadFromIni(ini, section);
  182.  
  183.   MinPosition := Point(ini.ReadInteger(section, 'Left', 128),
  184.                    ini.ReadInteger(section, 'Top', 128));
  185.   Update;
  186. end;
  187.  
  188.  
  189. procedure TShort.SaveToIni(ini : TIniFile; const section : string);
  190. begin
  191.   Ref.SaveToIni(ini, section);
  192.   with MinPosition do begin
  193.     ini.WriteInteger(section, 'Left', x);
  194.     ini.WriteInteger(section, 'Top', y);
  195.   end;
  196. end;
  197.  
  198. procedure TShort.FormDestroy(Sender: TObject);
  199. begin
  200.   FRef.Free;
  201. end;
  202.  
  203.  
  204. procedure TShort.SettingsChanged(Changes : TSettingChanges);
  205. begin
  206.   if scDesktop in Changes then Repaint;
  207. end;
  208.  
  209.  
  210. procedure TShort.WMMouseActivate(var Msg : TWMMouseActivate);
  211. begin
  212.   { To prevent shortcuts being moved when the icon is dragged,
  213.     the mouse down message is thrown away.  To catch double clicks,
  214.     the DoubleClickSpeed from WIN.INI (milliseconds?) is used to
  215.     time each mouse message.
  216.  
  217.     Consider using TimerCount from ToolHelp instead. }
  218.  
  219.   if StickyShorts or OneClickShorts then
  220.     with Msg do
  221.     if MouseMsg = WM_LBUTTONDOWN then begin
  222.       Result := MA_NOACTIVATEANDEAT;
  223.       if OneClickShorts or (GetTickCount < LastMouseDown + DoubleClickSpeed) then
  224.         Perform(WM_OPENSHORT, 0, 0);
  225.       LastMouseDown := GetTickCount;
  226.     end
  227.     else
  228.       inherited
  229.   else
  230.     inherited;
  231. end;
  232.  
  233.  
  234. end.
  235.  
  236.