home *** CD-ROM | disk | FTP | other *** search
/ PC Open 19 / pcopen19.iso / Zipped / CALMIR21.ZIP / SOURCE.ZIP / SRC / SHORTS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-02-20  |  8.6 KB  |  275 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 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. type
  38.   TShort = class(TCalForm)
  39.     DropClient: TDropClient;
  40.     SystemMenu: TSystemMenu;
  41.     procedure FormDragDrop(Sender, Source: TObject; X, Y: Integer);
  42.     procedure FormDragOver(Sender, Source: TObject; X, Y: Integer;
  43.       State: TDragState; var Accept: Boolean);
  44.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  45.     procedure FormCreate(Sender: TObject);
  46.     procedure DropClientDropFiles(Sender: TObject);
  47.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  48.     procedure FormDestroy(Sender: TObject);
  49.   private
  50.     { Private declarations }
  51.     FRef : TReference;
  52.     LastMouseDown : Longint;
  53.     procedure WMQueryOpen(var Msg: TWMQueryOpen); message WM_QUERYOPEN;
  54.     procedure WMOpenShort(var Msg : TMsg); message WM_OPENSHORT;
  55.     procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND;
  56.     procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
  57.     procedure WMMouseActivate(var Msg : TWMMouseActivate); message WM_MOUSEACTIVATE;
  58.     procedure WMLButtonDblClk(var Msg : TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
  59.     procedure WMKeyDown(var Msg : TWMKeyDown); message WM_KEYDOWN;
  60.     procedure RefChange(Sender : TObject);
  61.   public
  62.     { Public declarations }
  63.     procedure SettingsChanged(Changes : TSettingChanges); override;
  64.     property Ref : TReference read FRef;
  65.     procedure LoadFromIni(ini : TIniFile; const section:  string);
  66.     procedure SaveToIni(ini : TIniFile; const section : string);
  67.   end;
  68.  
  69.  
  70. implementation
  71.  
  72. {$R *.DFM}
  73.  
  74. uses Desk, Resource, IconWin, ShellAPI, FileMan, MultiGrd, WasteBin,
  75.   FileFind, Drives, Files, Strings, MiscUtil, CompSys, Graphics, Locale;
  76.  
  77. const
  78.   SC_PROPERTIES = SC_VSCROLL + 1024;
  79.   QueryClose : Boolean = False;
  80.  
  81.  
  82.  
  83. procedure TShort.WMQueryOpen(var Msg: TWMQueryOpen);
  84. begin
  85.   { New windows cannot be opened when inside SendMessage, so
  86.     an extra message must be posted to remind the shortcut to open.
  87.     0 is returned to keep the shortcut iconic }
  88.   Msg.Result := 0;
  89.   PostMessage(Handle, WM_OPENSHORT, 0, 0);
  90. end;
  91.  
  92.  
  93. procedure TShort.WMOpenShort(var Msg : TMsg);
  94. begin
  95.   Ref.Open;
  96. end;
  97.  
  98.  
  99. procedure TShort.WMSysCommand(var Msg: TWMSysCommand);
  100. var
  101.   P: TPoint;
  102.   R: TRect;
  103. begin
  104.   with Msg do
  105.     case CmdType and $FFF0 of
  106.       SC_CLOSE      : QueryClose := True;
  107.       SC_PROPERTIES : Ref.Edit;
  108.       SC_RESTORE    :
  109.         begin
  110.           { This extra code fixes the Alt-Tab activation bug.  Previously,
  111.             Alt-Tabbing to Calmira when a shortcut was last active would
  112.             generate an SC_RESTORE and open the shortcut again.
  113.  
  114.             We can now tell if this message was generated by Alt+Tab by
  115.             examining the cursor position.  The "physical" cursor must be
  116.             within the icon's boundaries, and also, Windows will provide
  117.             a positive cursor feedback in XPos and YPos if the Open
  118.             command was selected from the popup menu } 
  119.  
  120.           GetCursorPos(P);
  121.           with MinPosition do R := Bounds(X, Y, 32, 32);
  122.           if not PtInRect(R, P) and (XPos = 0) and (YPos = 0) then Exit;
  123.         end;
  124.     end;
  125.  
  126.   inherited;
  127.   QueryClose := False;
  128. end;
  129.  
  130.  
  131. procedure TShort.FormDragDrop(Sender, Source: TObject; X, Y: Integer);
  132. begin
  133.   Ref.DragDrop(Source);
  134. end;
  135.  
  136.  
  137. procedure TShort.FormDragOver(Sender, Source: TObject; X, Y: Integer;
  138.   State: TDragState; var Accept: Boolean);
  139. begin
  140.   Accept := (Source <> Computer.Grid) and ((Source <> Bin.Listbox) or
  141.     (Ref.Kind <> rkFile));
  142. end;
  143.  
  144.  
  145. procedure TShort.FormClose(Sender: TObject; var Action: TCloseAction);
  146. begin
  147.   Action := caFree;
  148. end;
  149.  
  150.  
  151. procedure TShort.FormCreate(Sender: TObject);
  152. var
  153.   buf : array[0..31] of Char;
  154. begin
  155.   with SystemMenu do begin
  156.     LoadString(HInstance, SMenuShortcutProperties, buf, 31);
  157.     Insert(6, buf, SC_PROPERTIES);
  158.     LoadString(HInstance, SMenuShortcutOpen, buf, 31);
  159.     Rename(SC_RESTORE, buf);
  160.     LoadString(HInstance, SMenuShortcutRemove, buf, 31);
  161.     Rename(SC_CLOSE, buf);
  162.     DeleteCommand(SC_SIZE);
  163.     DeleteCommand(SC_MINIMIZE);
  164.     DeleteCommand(SC_MAXIMIZE);
  165.     DeleteCommand(SC_TASKLIST);
  166.     Delete(5);
  167.   end;
  168.  
  169.   FRef := TShortcutReference.Create;
  170.   FRef.OnChange := RefChange;
  171. end;
  172.  
  173.  
  174. procedure TShort.WMPaint(var Msg: TWMPaint);
  175. begin
  176.   inherited;
  177.   if ShortArrows and (WindowState = wsMinimized) then
  178.     Canvas.Draw(0, 22, ShortArrow);
  179. end;
  180.  
  181.  
  182. procedure TShort.DropClientDropFiles(Sender: TObject);
  183. begin
  184.   Ref.AcceptFiles(DropClient.Files);
  185. end;
  186.  
  187.  
  188. procedure TShort.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  189. begin
  190.   { Query close is set to True when the user deletes the shortcut
  191.     from the popup menu.  During shutdown, this is False so shortcuts
  192.     are closed without asking }
  193.  
  194.   CanClose := not QueryClose or not ConfirmDelShort or
  195.     (MsgDialogResFmt(SQueryDeleteShortcut, [Caption],
  196.       mtConfirmation, mbOKCancel, 0) = mrOK);
  197. end;
  198.  
  199.  
  200. procedure TShort.RefChange(Sender : TObject);
  201. begin
  202.   Ref.AssignIcon(Icon);
  203.   Caption := Ref.Caption;
  204. end;
  205.  
  206.  
  207. procedure TShort.LoadFromIni(ini : TIniFile; const section:  string);
  208. begin
  209.   Ref.LoadFromIni(ini, section);
  210.  
  211.   MinPosition := Point(ini.ReadInteger(section, 'Left', 128),
  212.                    ini.ReadInteger(section, 'Top', 128));
  213.   Update;
  214. end;
  215.  
  216.  
  217. procedure TShort.SaveToIni(ini : TIniFile; const section : string);
  218. begin
  219.   Ref.SaveToIni(ini, section);
  220.   with MinPosition do begin
  221.     ini.WriteInteger(section, 'Left', x);
  222.     ini.WriteInteger(section, 'Top', y);
  223.   end;
  224. end;
  225.  
  226. procedure TShort.FormDestroy(Sender: TObject);
  227. begin
  228.   FRef.Free;
  229. end;
  230.  
  231.  
  232. procedure TShort.SettingsChanged(Changes : TSettingChanges);
  233. begin
  234.   if scDesktop in Changes then Repaint;
  235. end;
  236.  
  237.  
  238. procedure TShort.WMMouseActivate(var Msg : TWMMouseActivate);
  239. begin
  240.   { To prevent shortcuts being moved when the icon is dragged,
  241.     the mouse down message is thrown away.  To catch double clicks,
  242.     the DoubleClickSpeed from WIN.INI is used to time each message. }
  243.  
  244.   if StickyShorts or OneClickShorts then
  245.     with Msg do
  246.     if MouseMsg = WM_LBUTTONDOWN then begin
  247.       Result := MA_NOACTIVATEANDEAT;
  248.       if OneClickShorts or (GetTimerCount < LastMouseDown + DoubleClickSpeed) then
  249.         Perform(WM_OPENSHORT, 0, 0);
  250.     end
  251.     else
  252.       inherited
  253.   else
  254.     inherited;
  255.  
  256.   LastMouseDown := GetTimerCount;
  257. end;
  258.  
  259. procedure TShort.WMLButtonDblClk(var Msg : TWMLButtonDblClk);
  260. begin
  261.   PostMessage(Handle, WM_OPENSHORT, 0, 0);
  262. end;
  263.  
  264. procedure TShort.WMKeyDown(var Msg : TWMKeyDown);
  265. const
  266.   AltMask = $20000000;
  267. begin
  268.   if (Msg.CharCode = VK_F4) and (Msg.KeyData and AltMask <> 0) then Exit;
  269.   inherited;
  270. end;
  271.  
  272.  
  273. end.
  274.  
  275.