home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1998 April A / Pcwk4a98.iso / PROGRAM / DELPHI16 / Calmira / Src / SRC / SYS.PAS < prev    next >
Pascal/Delphi Source File  |  1997-02-15  |  29KB  |  995 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 Sys;
  24.  
  25. { System Window unit
  26.  
  27.   This form is the "acting" main form, even though Application.MainForm
  28.   actually points to the splash screen.  TSysWindow handles system
  29.   messages and other operations which are global to Calmira.  Desktop
  30.   interaction is handled here too but most tasks are delegated to
  31.   TDesktop to perform.
  32. }
  33.  
  34.  
  35. interface
  36.  
  37. uses
  38.   SysUtils, WinTypes, Messages, Classes, Controls, Forms, Dialogs,
  39.   Iconic, Menus, DragDrop, Dropclnt, Multigrd, DropServ, CalMsgs,
  40.   Grids, Start, Apholder, ObjList, CalForm, DdeMan, FormDrag, Settings,
  41.   Sysmenu;
  42.  
  43. type
  44.   TSysWindow = class(TCalForm)
  45.     WindowMenu: TPopupMenu;
  46.     About: TMenuItem;
  47.     HelpContents: TMenuItem;
  48.     Find: TMenuItem;
  49.     Grid: TMultiGrid;
  50.     App: TAppHolder;
  51.     DropServer: TDropServer;
  52.     RefreshSys: TMenuItem;
  53.     Dragger: TFormDrag;
  54.     DesktopMenu: TPopupMenu;
  55.     DeskProperties: TMenuItem;
  56.     DeskArrange: TMenuItem;
  57.     DeskClear: TMenuItem;
  58.     DeskClose: TMenuItem;
  59.     ConfigFileSystem: TMenuItem;
  60.     ConfigDesktop: TMenuItem;
  61.     ConfigStartMenu: TMenuItem;
  62.     ConfigBin: TMenuItem;
  63.     ConfigTaskbar: TMenuItem;
  64.     ObjectMenu: TPopupMenu;
  65.     Properties: TMenuItem;
  66.     CreateAlias: TMenuItem;
  67.     SysProperties: TMenuItem;
  68.     CascadeWins: TMenuItem;
  69.     Snap: TMenuItem;
  70.     N2: TMenuItem;
  71.     N3: TMenuItem;
  72.     N4: TMenuItem;
  73.     TopicSearch: TMenuItem;
  74.     N5: TMenuItem;
  75.     DeskFind: TMenuItem;
  76.     DeskRun: TMenuItem;
  77.     Run: TMenuItem;
  78.     DeskOpen: TMenuItem;
  79.     SystemMenu: TSystemMenu;
  80.     DeskExplore: TMenuItem;
  81.     MinimizeProgs: TMenuItem;
  82.     procedure FormDestroy(Sender: TObject);
  83.     procedure FormResize(Sender: TObject);
  84.     procedure GridDblClick(Sender: TObject);
  85.     procedure CreateAliasClick(Sender: TObject);
  86.     procedure PropertiesClick(Sender: TObject);
  87.     procedure AboutClick(Sender: TObject);
  88.     procedure HelpContentsClick(Sender: TObject);
  89.     procedure FormCreate(Sender: TObject);
  90.     procedure FindClick(Sender: TObject);
  91.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  92.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  93.     procedure GridDrawCell(Sender: TObject; Index: Integer; Rect: TRect;
  94.       State: TGridDrawState);
  95.     procedure GridSelectCell(Sender: TObject; Index: Integer;
  96.       var CanSelect: Boolean);
  97.     procedure DropServerFileDrag(Sender: TObject; X, Y: Integer;
  98.       Target: Word; var Accept: Boolean);
  99.     procedure GridMouseDown(Sender: TObject; Button: TMouseButton;
  100.       Shift: TShiftState; X, Y: Integer);
  101.     procedure DropServerDeskDrop(Sender: TObject; X, Y: Integer;
  102.       Target: Word);
  103.     procedure AppException(Sender: TObject; E: Exception);
  104.     procedure AppShowHint(var HintStr: OpenString; var CanShow: Boolean;
  105.       var HintInfo: THintInfo);
  106.     procedure GridMouseMove(Sender: TObject; Shift: TShiftState; X,
  107.       Y: Integer);
  108.     procedure AppMessage(var Msg: TMsg; var Handled: Boolean);
  109.     procedure GridEndDrag(Sender, Target: TObject; X, Y: Integer);
  110.     procedure AppActivate(Sender: TObject);
  111.     procedure AppDeactivate(Sender: TObject);
  112.     procedure RefreshSysClick(Sender: TObject);
  113.     procedure FormPaint(Sender: TObject);
  114.     procedure DeskPropertiesClick(Sender: TObject);
  115.     procedure DeskArrangeClick(Sender: TObject);
  116.     procedure DeskClearClick(Sender: TObject);
  117.     procedure DeskCloseClick(Sender: TObject);
  118.     procedure ConfigDesktopClick(Sender: TObject);
  119.     procedure ConfigStartMenuClick(Sender: TObject);
  120.     procedure ConfigBinClick(Sender: TObject);
  121.     procedure ConfigTaskbarClick(Sender: TObject);
  122.     procedure ConfigFileSystemClick(Sender: TObject);
  123.     procedure ObjectMenuPopup(Sender: TObject);
  124.     procedure SysPropertiesClick(Sender: TObject);
  125.     procedure CascadeWinsClick(Sender: TObject);
  126.     procedure SnapClick(Sender: TObject);
  127.     procedure TopicSearchClick(Sender: TObject);
  128.     function AppWndProc(var Message: TMessage): Boolean;
  129.     procedure DeskOpenClick(Sender: TObject);
  130.     procedure AppActiveFormChange(Sender: TObject);
  131.     procedure RunClick(Sender: TObject);
  132.     procedure DeskRunClick(Sender: TObject);
  133.     procedure DeskExploreClick(Sender: TObject);
  134.     procedure GridKeyDown(Sender: TObject; var Key: Word;
  135.       Shift: TShiftState);
  136.     procedure FormDragOver(Sender, Source: TObject; X, Y: Integer;
  137.       State: TDragState; var Accept: Boolean);
  138.     procedure FormDragDrop(Sender, Source: TObject; X, Y: Integer);
  139.     procedure MinimizeProgsClick(Sender: TObject);
  140.   private
  141.     { Private declarations }
  142.     Selected : TIconic;
  143.     FItems : TObjectList;
  144.     procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND;
  145.     procedure WMCommand(var Msg: TWMCommand);   message WM_COMMAND;
  146.     procedure WMNCRButtonDown(var Msg: TWMNCRButtonDown); message WM_NCRBUTTONDOWN;
  147.     procedure WMDeskMenu(var Msg: TMessage); message WM_DESKMENU;
  148.     procedure StartMacro(Sender : TObject; const macro, params : string);
  149.   public
  150.     procedure Configure;
  151.     procedure ReadINISettings;
  152.     procedure SettingsChanged(Changes : TSettingChanges); override;
  153.     procedure KeyCommand(const title : string);
  154.     property Items: TObjectList read FItems;
  155.   end;
  156.  
  157. const
  158.   { Custom system menu commands }
  159.  
  160.   SC_ARRANGEICONS    = SC_VSCROLL + 1000;
  161.   SC_CLEARDESKTOP    = SC_VSCROLL + 1001;
  162.   SC_CLOSEBROWSERS   = SC_VSCROLL + 1002;
  163.   SC_ABOUT           = SC_VSCROLL + 1003;
  164.   SC_CASCADEBROWSERS = SC_VSCROLL + 1004;
  165.   SC_LINEUPICONS     = SC_VSCROLL + 1005;
  166.  
  167. var
  168.   SysWindow: TSysWindow;
  169.   LastErrorMode: Integer;
  170.  
  171.  
  172. implementation
  173.  
  174. {$R *.DFM}
  175.  
  176. uses Desk, Shorts, DiskProp, Directry, About, IconWin, WinProcs, Drives,
  177.   FileFind, IniFiles, Resource, Strings, MiscUtil, Files, FileMan, Environs,
  178.   WasteBin, FileCtrl, Graphics, Tree, ShutDown, RunProg, Referenc, ChkList,
  179.   ShellAPI, StrtProp, DeskProp, TaskProp, SysProp, FSysProp, Debug;
  180.  
  181. { The taskbar module uses WndHooks.dll, but Calmira needs to as well.
  182.   When Calmira is the shell, Windows looks in the current directory
  183.   and the DOS search path for any implicitly referenced DLLs.  This
  184.   means that Calmira's home dir must be added to the search path,
  185.   which wastes valuable path space.
  186.  
  187.   To remedy this, we load WndHooks.dll explicitly using the LoadLibrary
  188.   function, which can be told where to look for a DLL.  It involves
  189.   a bit more coding but is well worth it.
  190. }
  191.  
  192. var
  193.   { DLL module instance and procedure pointers }
  194.   WndHookDLL: THandle;
  195.   SetDesktopHook : procedure(CallBack: HWND);
  196.   ReleaseDesktopHook : procedure;
  197.   SetRCloseEnabled : procedure(Enable: Boolean);
  198.  
  199.  
  200. { This unit is responsible for opening various non-modal windows.
  201.   Inconsistencies will arise if non-modal icon windows are opened while
  202.   a modal dialog is showing, so the IsDialogModal function is used. }
  203.  
  204. function IsDialogModal : Boolean;
  205. begin
  206.   Result := not IsWindowEnabled(Application.MainForm.Handle);
  207. end;
  208.  
  209. function CheckDialogModal: Boolean;
  210. var Msg : string[127];
  211. begin
  212.   Result := IsDialogModal;
  213.   if Result then begin
  214.     if Screen.ActiveForm = nil then
  215.       Msg := 'Please close Calmira''s active dialog box first'
  216.     else
  217.       Msg := Format('Please close the "%s" dialog first', [Screen.ActiveForm.Caption]);
  218.     MsgDialog(Msg, mtInformation, [mbOK], 0);
  219.   end;
  220. end;
  221.  
  222.  
  223. procedure TSysWindow.FormDestroy(Sender: TObject);
  224. begin
  225.   ReleaseDesktopHook;
  226.   FItems.Free;
  227.   FreeLibrary(WndHookDLL);
  228. end;
  229.  
  230.  
  231. procedure TSysWindow.FormResize(Sender: TObject);
  232. begin
  233.   Grid.Width := ClientWidth - 8;
  234.   Grid.Height := ClientHeight - 8;
  235.   Grid.SizeGrid;
  236.   Selected := nil;
  237.   Invalidate;
  238. end;
  239.  
  240.  
  241. procedure TSysWindow.GridDblClick(Sender: TObject);
  242. begin
  243.   if Selected <> nil then Selected.Open;
  244. end;
  245.  
  246.  
  247. procedure TSysWindow.CreateAliasClick(Sender: TObject);
  248. var
  249.   filename : TFilename;
  250. begin
  251.   if Selected is TDrive then
  252.     filename := 'c:\drive' + LowCase(TDrive(Selected).Letter) + '.als'
  253.   else
  254.     filename := ChangeFileExt(TProgram(Selected).Filename, '.als');
  255.  
  256.   if InputQuery('Create alias', 'Alias filename', filename) then
  257.     Selected.WriteAlias(Lowercase(filename));
  258. end;
  259.  
  260.  
  261. procedure TSysWindow.PropertiesClick(Sender: TObject);
  262. begin
  263.   if Selected is TDrive then DiskPropExecute(TDrive(Selected).Letter);
  264. end;
  265.  
  266.  
  267. procedure TSysWindow.AboutClick(Sender: TObject);
  268. begin
  269.   ShowModalDialog(TAboutBox);
  270. end;
  271.  
  272.  
  273. procedure TSysWindow.AppException(Sender: TObject; E: Exception);
  274. begin
  275.   { Use MessageDialog to display exception messages because
  276.     the forms look nicer in a small font }
  277.   MsgDialog(E.Message, mtError, [mbOK], E.HelpContext);
  278. end;
  279.  
  280.  
  281. procedure TSysWindow.WMSysCommand(var Msg: TWMSysCommand);
  282. begin
  283.   case Msg.CmdType of
  284.     SC_ABOUT         : About.Click;
  285.     SC_ARRANGEICONS  : DeskArrange.Click;
  286.     SC_CLEARDESKTOP  : DeskClear.Click;
  287.     SC_CLOSEBROWSERS : DeskClose.Click;
  288.     SC_CASCADEBROWSERS : CascadeWins.Click;
  289.     SC_LINEUPICONS : Snap.Click;
  290.   end;
  291.   inherited;
  292. end;
  293.  
  294.  
  295. procedure TSysWindow.WMCommand(var Msg: TWMCommand);
  296. var item: TMenuItem;
  297. begin
  298.   item := StartMenu.FindItem(Msg.ItemID, fkCommand);
  299.   if item <> nil then item.Click;
  300.   inherited;
  301. end;
  302.  
  303.  
  304. procedure TSysWindow.HelpContentsClick(Sender: TObject);
  305. begin
  306.    Application.HelpJump('Contents');
  307. end;
  308.  
  309.  
  310. procedure TSysWindow.FormCreate(Sender: TObject);
  311. var
  312.   i: Integer;
  313.   buf : array[0..79] of Char;
  314. begin
  315.   { Load the Windows hook DLL and obtain pointers to the procedures we need }
  316.   WndHookDLL := LoadLibrary(StrPCopy(buf, ApplicationPath + 'WNDHOOKS.DLL'));
  317.   @SetDesktopHook     := GetProcAddress(WndHookDLL, 'SETDESKTOPHOOK');
  318.   @ReleaseDesktopHook := GetProcAddress(WndHookDLL, 'RELEASEDESKTOPHOOK');
  319.   @SetRCloseEnabled   := GetProcAddress(WndHookDLL, 'SETRCLOSEENABLED');
  320.  
  321.   Icon.Assign(Icons.Get('System'));
  322.  
  323.   FItems := TObjectList.Create;
  324.   AppActivate(self);
  325.  
  326.   with SystemMenu do begin
  327.     AddSeparator;
  328.     Add('Cascade browsers', SC_CASCADEBROWSERS);
  329.     Add('Arrange icons', SC_ARRANGEICONS);
  330.     Add('Line up icons', SC_LINEUPICONS);
  331.     Add('Close browsers', SC_CLOSEBROWSERS);
  332.     Add('Clear desktop', SC_CLEARDESKTOP);
  333.     AddSeparator;
  334.     Add('About...', SC_ABOUT);
  335.     DeleteCommand(SC_SIZE);
  336.   end;
  337.  
  338.   StartMenu.OnStartMacro := StartMacro;
  339.  
  340.   ReadINISettings;
  341.   Configure;
  342.   LoadPosition(ini, 'System');
  343.   Resize;
  344.   Update;
  345. end;
  346.  
  347. procedure TSysWindow.ReadINISettings;
  348. begin
  349.   RefreshSys.Click;
  350. end;
  351.  
  352. procedure TSysWindow.Configure;
  353. begin
  354.   Caption := SysCaption;
  355.   Color := Colors[ccWinFrame];
  356.   Font.Assign(GlobalFont);
  357.  
  358.   with Grid do begin
  359.     Visible := False;
  360.     Color := Colors[ccIconBack];
  361.     SelColor := Colors[ccIconSel];
  362.     DefaultColWidth := BrowseGrid.X;
  363.     DefaultRowHeight := BrowseGrid.Y;
  364.     Font.Assign(GlobalFont);
  365.     Canvas.Font.Assign(Font);
  366.     Visible := True;
  367.   end;
  368.  
  369.   with Dragger do begin
  370.     Hollow := HollowDrag;
  371.     MinWidth := BrowseGrid.X + XSpare;
  372.     MinHeight := BrowseGrid.Y + XSpare;
  373.   end;
  374.  
  375.   if ShowDeskMenu then SetDesktopHook(Handle)
  376.   else ReleaseDesktopHook;
  377.  
  378.   SetRCloseEnabled(RightClose);
  379. end;
  380.  
  381.  
  382. procedure TSysWindow.FindClick(Sender: TObject);
  383. var s: TFilename;
  384. begin
  385.   if CheckDialogModal then Exit;
  386.   GetDir(0, s);
  387.   FileFindExecute(Copy(s, 1, 3), 0);
  388. end;
  389.  
  390.  
  391. procedure TSysWindow.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  392. begin
  393.   if SysWinQuit then begin
  394.     { save the desktop before it's too late! }
  395.     Desktop.Save;
  396.  
  397.     if IsShell then begin
  398.       { Always ask before a shell is closed down.  The InSendMessage is
  399.         there for a reason: a slight problem arises when Windows Setup tries
  400.         to restart Windows -- the call to ExitWindows returns false, so
  401.         Calmira doesn't quit and Setup backs off.  The trick is to detect
  402.         when Setup is the "caller" using InSendMessage
  403.       }
  404.  
  405.       CanClose := MsgDialog('This will end your Windows session.',
  406.         mtInformation, [mbOK, mbCancel], 0) = mrOK;
  407.       if CanClose and not InSendMessage then CanClose := Bool(ExitWindows(0, 0));
  408.     end
  409.  
  410.     else
  411.       CanClose := not QueryQuit or
  412.        (MsgDialog('Are you sure you want to close Calmira?', mtConfirmation,
  413.          [mbYes, mbNo], 0) = mrYes);
  414.   end;
  415. end;
  416.  
  417. procedure TSysWindow.FormClose(Sender: TObject; var Action: TCloseAction);
  418. begin
  419.   if SysWinQuit then Application.Terminate
  420.   else Action := caMinimize;
  421. end;
  422.  
  423.  
  424. procedure TSysWindow.WMNCRButtonDown(var Msg: TWMNCRButtonDown);
  425. begin
  426.   with Msg do
  427.     if (WindowState = wsMinimized) or (HitTest = HTSYSMENU) then
  428.       StartMenu.Popup(XCursor, YCursor, False)
  429.     else
  430.       inherited;
  431. end;
  432.  
  433.  
  434. procedure TSysWindow.GridDrawCell(Sender: TObject; Index: Integer;
  435.   Rect: TRect; State: TGridDrawState);
  436. begin
  437.   if Index < FItems.Count then TIconic(FItems[Index]).Draw(Grid.Canvas, Rect);
  438. end;
  439.  
  440.  
  441. procedure TSysWindow.GridSelectCell(Sender: TObject; Index: Integer;
  442.   var CanSelect: Boolean);
  443. begin
  444.    CanSelect := Index < FItems.Count;
  445.    if CanSelect then Selected := TIconic(FItems[Index]) else Selected := nil;
  446. end;
  447.  
  448.  
  449. procedure TSysWindow.DropServerFileDrag(Sender: TObject; X, Y: Integer;
  450.   Target: Word; var Accept: Boolean);
  451. begin
  452.   Accept := Target = GetDesktopWindow;
  453. end;
  454.  
  455.  
  456. procedure TSysWindow.GridMouseDown(Sender: TObject; Button: TMouseButton;
  457.   Shift: TShiftState; X, Y: Integer);
  458. var
  459.   i: Integer;
  460.   p: TPoint;
  461.   rect : TRect;
  462. begin
  463.   if Button = mbLeft then begin
  464.     if Selected <> nil then Grid.BeginDrag(False)
  465.   end
  466.   else begin
  467.     { popup one of the menus depending on whether the cursor
  468.       is directly over an icon }
  469.     i := Grid.MouseToCell(X, Y);
  470.     rect := Grid.CellBounds(i);
  471.     InflateRect(rect, -16, -8);
  472.     OffsetRect(rect, 0, -8);
  473.     GetCursorPos(p);
  474.  
  475.     if PtInRect(rect, Point(x, y)) and (i < Items.Count) then begin
  476.       Grid.Select(i);
  477.       ObjectMenu.Popup(p.x, p.y)
  478.     end
  479.     else
  480.       WindowMenu.Popup(p.X, p.Y);
  481.   end;
  482. end;
  483.  
  484.  
  485. procedure TSysWindow.DropServerDeskDrop(Sender: TObject; X, Y: Integer;
  486.   Target: Word);
  487. begin
  488.   Selected.CreateShortcut.MinPosition := Point(X - 16, Y - 16);
  489. end;
  490.  
  491.  
  492. procedure TSysWindow.AppShowHint(var HintStr: OpenString;
  493.   var CanShow: Boolean; var HintInfo: THintInfo);
  494. var
  495.   f : TDirItem;
  496.   w : TIconWindow;
  497.   i : Integer;
  498. begin
  499.   { Handles popup file hints.  A hint is shown only when there
  500.     is no dragging taking place, otherwise the hint window will
  501.     interfere with the focus rect.  The hint is shown slightly
  502.     above the cursor and is forced to hide or change once the
  503.     cursor leaves the current cell.
  504.   }
  505.  
  506.   with HintInfo do
  507.     if (HintControl is TMultiGrid) and FileHints then
  508.       with TMultiGrid(HintControl) do begin
  509.         if not (Owner is TIconWindow) then Exit;
  510.         w := TIconWindow(Owner);
  511.         if (GetCaptureControl <> nil) or w.ViewList.Checked then Exit;
  512.         f := w.FileAt(CursorPos.X, CursorPos.Y, True);
  513.         CanShow := f <> nil;
  514.         if not CanShow then Exit;
  515.         CursorRect := CellBounds(MouseToCell(CursorPos.X, CursorPos.Y));
  516.         with ClientToScreen(CursorPos) do HintPos := Point(X, Y - 24);
  517.         HintStr := f.Hint;
  518.       end
  519.  
  520.     else if HintControl is TCheckList then
  521.       with TCheckList(HintControl) do begin
  522.         i := ItemAtPos(CursorPos, False);
  523.         if (i < 0) or (i >= Hints.Count) then Exit;
  524.         HintStr := Hints[i];
  525.         CursorRect := ItemRect(i);
  526.       end;
  527. end;
  528.  
  529.  
  530. procedure TSysWindow.GridMouseMove(Sender: TObject; Shift: TShiftState; X,
  531.   Y: Integer);
  532. begin
  533.   if Grid.Dragging and DropServer.CanDrop and AnimCursor then
  534.     SetCursor(Screen.Cursors[crFlutter])
  535. end;
  536.  
  537.  
  538. function CouldBeFolder(const s: string): Boolean;
  539. begin
  540.   Result := (s[1] in Alphas) and (s[2] = ':') and (s[3] = '\');
  541. end;
  542.  
  543.  
  544. function EnumTitleProc(Wnd : HWND; caption: PString):Bool; export;
  545. var
  546.   buf: TCaption;
  547. begin
  548.   Result := True;
  549.   buf[0] := Chr(GetWindowText(Wnd, @buf[1], 78));
  550.   if CompareText(buf, caption^) = 0 then begin
  551.     SendMessage(Wnd, WM_ACTIVATE, WA_ACTIVE, MakeLong(Wnd, Word(True)));
  552.     if IsIconic(Wnd) then ShowWindow(Wnd, SW_RESTORE)
  553.     else BringWindowToTop(Wnd);
  554.     Result := False;
  555.   end
  556. end;
  557.  
  558.  
  559. procedure TSysWindow.KeyCommand(const title : string);
  560. var
  561.   i : Integer;
  562.   f : TForm;
  563.   item : TMenuItem;
  564. begin
  565.   { First look for a matching form caption }
  566.   with Screen do
  567.   for i := 0 to FormCount-1 do begin
  568.     f := Forms[i];
  569.     if CompareText(f.Caption, title) = 0 then begin
  570.       if f is TShort then
  571.         f.Perform(WM_OPENSHORT, 0, 0)
  572.       else if f.Visible and f.Enabled then begin
  573.         f.WindowState := wsNormal;
  574.         f.BringToFront;
  575.       end;
  576.       Exit;
  577.     end;
  578.   end;
  579.  
  580.   item := StartMenu.Find(title, False);
  581.   if item <> nil then
  582.     item.Click
  583.   else if CouldBeFolder(title) and HDirectoryExists(title) then
  584.     Desktop.OpenFolder(title)
  585.   else
  586.     EnumWindows(@EnumTitleProc, Longint(@title));
  587. end;
  588.  
  589.  
  590. procedure TSysWindow.AppMessage(var Msg: TMsg; var Handled: Boolean);
  591. var
  592.   Shift : TShiftState;
  593.   i : Integer;
  594. begin
  595.   with Msg do
  596.     case Message of
  597.     WM_CLOSE:
  598.       if Msg.HWnd = Application.Handle then begin
  599.         { The program has been closed from the taskbar or Task Manager }
  600.         Desktop.Save;
  601.         if IsShell then begin
  602.           Handled := True;
  603.           if MsgDialog('This will end your Windows session.',
  604.              mtInformation, [mbOK, mbCancel], 0) = mrOK then ExitWindows(0, 0);
  605.         end;
  606.       end;
  607.  
  608.     WM_DROPFILES :
  609.       TDropClient.CheckMessage(Msg, Handled);
  610.  
  611.     WM_KEYDOWN :
  612.       { Check for keyboard shortcuts.  Exceptions must be handled explicitly,
  613.         otherwise the program will be terminated by the Delphi RTL }
  614.  
  615.       if not IsDialogModal then
  616.       try
  617.         Shift := KeyDataToShiftState(Msg.lParam);
  618.  
  619.         if (Msg.wParam = VK_TAB) and (Shift = [ssCtrl]) then
  620.           Desktop.NextForm
  621.  
  622.         else if (ssCtrl in Shift) and (ssAlt in Shift) then begin
  623.           i := KeyMaps.IndexOfObject(TObject(Shortcut(Msg.wParam, Shift)));
  624.           if i > -1 then KeyCommand(KeyMaps[i]);
  625.         end;
  626.       except
  627.         on E: Exception do Application.HandleException(E);
  628.       end;
  629.  
  630.     $C000..$FFFF : { registered messages }
  631.       if Message = WM_CALMIRA then begin
  632.         case wParam of
  633.           CM_PREVINSTANCE: begin
  634.                              BringToFront;
  635.                              WindowState := wsNormal;
  636.                            end;
  637.           CM_STARTMENU  :  with TPoint(lParam) do begin
  638.                              StartMenu.Popup(X, Y - StartMenu.Height, not StartMouseUp);
  639.                              PostMessage(TaskbarWindow, WM_CALMIRA, CM_STARTCLOSE, 0);
  640.                            end;
  641.           CM_EXPLORER    : OpenExplorer('');
  642.           CM_ARRANGEICONS: Desktop.ArrangeIcons;
  643.           CM_STARTPROP   : ConfigStartMenu.Click;
  644.           CM_TASKPROP    : ConfigTaskbar.Click;
  645.         end;
  646.         Handled := True;
  647.       end;
  648.     end;
  649. end;
  650.  
  651.  
  652. procedure TSysWindow.GridEndDrag(Sender, Target: TObject; X, Y: Integer);
  653. begin
  654.   DropServer.DragFinished;
  655. end;
  656.  
  657.  
  658. const
  659.   CommandList : array[0..11] of string[23] =
  660.     ({0}'$FOLDER', {1}'$SYSTEM', {2}'$RUN', {3}'$EXPLORE', {4}'$FIND',
  661.      {5}'$SHUTDOWN', {6}'$SYSTEMPROP', {7}'$DESKTOPPROP',
  662.      {8}'$FILESYSTEMPROP', {9}'$TASKBARPROP', {10}'$BINPROP',
  663.      {11}'$STARTMENUPROP');
  664.  
  665. function FindCommand(const s: string): Integer;
  666. begin
  667.   for Result := 0 to High(CommandList) do
  668.     if CommandList[Result] = s then Exit;
  669.   Result := -1;
  670. end;
  671.  
  672. procedure TSysWindow.StartMacro(Sender : TObject; const macro, params : string);
  673. var
  674.   foldername: TFilename;
  675.   filespec : string[12];
  676.   l, t, w, h: Integer;
  677.   IconWindow : TIconWindow;
  678. begin
  679.   if not CheckDialogModal then
  680.   case FindCommand(Uppercase(macro)) of
  681.    0: begin
  682.         if params = '' then begin
  683.           DeskOpen.Click;
  684.           Exit;
  685.         end;
  686.  
  687.         if (Pos('*', params) > 0) or (Pos('?', params) > 0) then begin
  688.           filespec := ExtractFilename(params);
  689.           foldername := ExtractFileDir(params);
  690.         end
  691.         else begin
  692.           filespec := DefaultFilter;
  693.           foldername := params;
  694.         end;
  695.  
  696.         IconWindow := Desktop.WindowOf(foldername);
  697.         if IconWindow = nil then
  698.           TIconWindow.Init(Application, foldername, filespec).Show
  699.         else with IconWindow do begin
  700.           Dir.Filter := filespec;
  701.           RefreshWin;
  702.           ShowNormal;
  703.         end;
  704.       end;
  705.    1: ShowNormal;
  706.    2: RunExecute('');
  707.    3: OpenExplorer('');
  708.    4: Find.Click;
  709.    5: ShowModalDialog(TQuitDlg);
  710.    6: SysProperties.Click;
  711.    7: ConfigDesktop.Click;
  712.    8: ConfigFileSystem.Click;
  713.    9: ConfigTaskbar.Click;
  714.    10: ConfigBin.Click;
  715.    11: ConfigStartMenu.Click;
  716.   else
  717.     MsgDialog(Format('Unknown command "%s"', [macro]), mtError, [mbOK], 0);
  718.   end;
  719. end;
  720.  
  721.  
  722. function ProvideLastIcon(Instance : Word) : HIcon;
  723. begin
  724.   { If the last program the user executed matches the given instance
  725.     handle, then an icon is extracted if the user specified a
  726.     particular one }
  727.  
  728.   Result := 0;
  729.  
  730.   if CalIcons and (Instance = LastInstance) then begin
  731.     if LastIconFile > '' then
  732.       Result := ExtractIcon(HInstance, StringAsPChar(LastIconFile), LastIconIndex);
  733.     LastInstance := 0;
  734.     LastIconFile := '';
  735.     LastIconIndex := 0;
  736.   end
  737. end;
  738.  
  739.  
  740. procedure TSysWindow.AppActivate(Sender: TObject);
  741. begin
  742.   LastErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
  743. end;
  744.  
  745. procedure TSysWindow.AppDeactivate(Sender: TObject);
  746. begin
  747.   SetErrorMode(LastErrorMode);
  748. end;
  749.  
  750.  
  751. procedure TSysWindow.RefreshSysClick(Sender: TObject);
  752. var
  753.   drive : Char;
  754.   progs : TStringList;
  755.   i: Integer;
  756.   progname : TFilename;
  757.   p : TProgram;
  758. begin
  759.   Selected := nil;
  760.   FItems.ClearObjects;
  761.  
  762.   { Add the disk drives }
  763.   for drive := 'A' to 'Z' do
  764.     if drive in ValidDrives then FItems.Add(TDrive.Create(drive));
  765.  
  766.   { Add the program "shortcuts" }
  767.   progs := TStringList.Create;
  768.   try
  769.     ini.ReadSection('Programs', progs);
  770.  
  771.     for i := 0 to progs.Count-1 do begin
  772.       progname := progs[i];
  773.       if ExtractFilePath(progname) = ''
  774.         then progname := ApplicationPath + progname;
  775.       if FileExists(progname) then begin
  776.         p := TProgram.Create(progname);
  777.         p.Caption := ini.ReadString('Programs', progs[i], ExtractFilename(progs[i]));
  778.         FItems.Add(p);
  779.       end;
  780.     end;
  781.   finally
  782.     progs.Free;
  783.   end;
  784.  
  785.   with Grid do begin
  786.     Reset;
  787.     Limit := FItems.Count;
  788.     SizeGrid;
  789.     Focus := 0;
  790.   end;
  791.   Invalidate;
  792. end;
  793.  
  794.  
  795. procedure TSysWindow.FormPaint(Sender: TObject);
  796. begin
  797.   Border3D(Canvas, ClientWidth-1, ClientHeight-1);
  798. end;
  799.  
  800.  
  801. procedure TSysWindow.WMDeskMenu(var Msg: TMessage);
  802. begin
  803.   with TPoint(Msg.lParam) do DesktopMenu.Popup(X, Y);
  804. end;
  805.  
  806.  
  807. procedure TSysWindow.DeskPropertiesClick(Sender: TObject);
  808. begin
  809.   ConfigDesktop.Click;
  810. end;
  811.  
  812.  
  813. procedure TSysWindow.DeskArrangeClick(Sender: TObject);
  814. begin
  815.   Desktop.ArrangeIcons;
  816. end;
  817.  
  818.  
  819. procedure TSysWindow.DeskClearClick(Sender: TObject);
  820. begin
  821.   if not CheckDialogModal then Application.Minimize;
  822. end;
  823.  
  824.  
  825. procedure TSysWindow.DeskCloseClick(Sender: TObject);
  826. begin
  827.   if not CheckDialogModal then Desktop.CloseWindows;
  828. end;
  829.  
  830.  
  831. procedure TSysWindow.ConfigDesktopClick(Sender: TObject);
  832. begin
  833.   if not CheckDialogModal then ShowModalDialog(TDeskPropDlg);
  834. end;
  835.  
  836.  
  837. procedure TSysWindow.ConfigStartMenuClick(Sender: TObject);
  838. begin
  839.   if CheckDialogModal then Exit;
  840.   if StartPropDlg = nil then
  841.     StartPropDlg := TStartPropDlg.Create(Application);
  842.   StartPropDlg.Show;
  843. end;
  844.  
  845.  
  846. procedure TSysWindow.ConfigBinClick(Sender: TObject);
  847. begin
  848.   Bin.Properties.Click;
  849. end;
  850.  
  851.  
  852. procedure TSysWindow.ConfigTaskbarClick(Sender: TObject);
  853. begin
  854.   ShowModalDialog(TTaskPropDlg);
  855. end;
  856.  
  857.  
  858. procedure TSysWindow.ConfigFileSystemClick(Sender: TObject);
  859. begin
  860.   ShowModalDialog(TFileSysPropDlg);
  861. end;
  862.  
  863.  
  864. procedure TSysWindow.ObjectMenuPopup(Sender: TObject);
  865. begin
  866.   CreateAlias.Enabled := Selected <> nil;
  867.   Properties.Enabled := Selected is TDrive;
  868. end;
  869.  
  870.  
  871. procedure TSysWindow.SysPropertiesClick(Sender: TObject);
  872. begin
  873.   ShowModalDialog(TSysPropDlg);
  874. end;
  875.  
  876.  
  877. procedure TSysWindow.CascadeWinsClick(Sender: TObject);
  878. begin
  879.   if not CheckDialogModal then Desktop.Cascade;
  880. end;
  881.  
  882.  
  883. procedure TSysWindow.SnapClick(Sender: TObject);
  884. begin
  885.   Desktop.SnapToGrid;
  886. end;
  887.  
  888.  
  889. procedure TSysWindow.TopicSearchClick(Sender: TObject);
  890. const
  891.   EmptyString : PChar = '';
  892. begin
  893.   Application.HelpCommand(HELP_PARTIALKEY, Longint(EmptyString));
  894. end;
  895.  
  896.  
  897. function TSysWindow.AppWndProc(var Message: TMessage): Boolean;
  898. begin
  899.   AppWndProc := False;
  900.  
  901.   with Message do
  902.     if (Msg = WM_ENDSESSION) and Bool(wParam) then
  903.       Desktop.Save
  904.     else if (Msg = WM_CALMIRA) and (wParam = CM_GETTASKICON) then begin
  905.       Result := ProvideLastIcon(lParam);
  906.       AppWndProc := True;
  907.     end;
  908. end;
  909.  
  910.  
  911.  
  912. procedure TSysWindow.SettingsChanged(Changes : TSettingChanges);
  913. begin
  914.   if [scSystem, scFileSystem, scDesktop, scDisplay] * Changes <> [] then
  915.     Configure;
  916.  
  917.   if [scDevices, scINIFile] * Changes <> [] then RefreshSys.Click;
  918. end;
  919.  
  920.  
  921. procedure TSysWindow.DeskOpenClick(Sender: TObject);
  922. var
  923.   s: TFilename;
  924. begin
  925.   if CheckDialogModal then Exit;
  926.   s := '';
  927.   if InputQuery('Open folder', 'Folder name', s) then
  928.     Desktop.OpenFolder(ExpandFilename(s));
  929. end;
  930.  
  931.  
  932. procedure TSysWindow.AppActiveFormChange(Sender: TObject);
  933. var s: TCaption;
  934. begin
  935.   if ComponentState <> [] then Exit;
  936.  
  937.   if Screen.ActiveForm is TIconWindow then begin
  938.     s := Screen.ActiveForm.Caption;
  939.     Environment.Values['CURRENTFOLDER'] := s;
  940.     Environment.Values['CURRENTDRIVE'] := s[1];
  941.   end
  942.   else begin
  943.     Environment.Values['CURRENTFOLDER'] := '';
  944.     Environment.Values['CURRENTDRIVE'] := '';
  945.   end;
  946. end;
  947.  
  948.  
  949. procedure TSysWindow.RunClick(Sender: TObject);
  950. begin
  951.   if CheckDialogModal then Exit;
  952.   RunExecute('');
  953. end;
  954.  
  955. procedure TSysWindow.DeskRunClick(Sender: TObject);
  956. begin
  957.   if not CheckDialogModal then RunExecute('');
  958. end;
  959.  
  960. procedure TSysWindow.DeskExploreClick(Sender: TObject);
  961. begin
  962.   if not CheckDialogModal then OpenExplorer('');
  963. end;
  964.  
  965. procedure TSysWindow.GridKeyDown(Sender: TObject; var Key: Word;
  966.   Shift: TShiftState);
  967. var
  968.   item: TMenuItem;
  969. begin
  970.   item := WindowMenu.FindItem(Shortcut(Key, Shift), fkShortcut);
  971.   if item <> nil then item.Click;
  972. end;
  973.  
  974. procedure TSysWindow.FormDragOver(Sender, Source: TObject; X, Y: Integer;
  975.   State: TDragState; var Accept: Boolean);
  976. begin
  977.   Accept := (Source is TMultiGrid) and (TMultiGrid(Source).Owner is TIconWindow);
  978. end;
  979.  
  980. procedure TSysWindow.FormDragDrop(Sender, Source: TObject; X, Y: Integer);
  981. var i: Integer;
  982. begin
  983.   with ((Source as TMultiGrid).Owner as TIconWindow).CompileSelection(False) do
  984.     for i := 0 to Count-1 do
  985.       with  TDirItem(Items[i]) do
  986.         NewStartItems.Values[GetTitle] := GetStartInfo;
  987. end;
  988.  
  989. procedure TSysWindow.MinimizeProgsClick(Sender: TObject);
  990. begin
  991.   PostMessage(TaskbarWindow, WM_CALMIRA, CM_MINIMIZEALL, 0);
  992. end;
  993.  
  994. end.
  995.