home *** CD-ROM | disk | FTP | other *** search
/ PC Open 19 / pcopen19.iso / Zipped / CALMIR21.ZIP / SOURCE.ZIP / SRC / COMPSYS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-02-20  |  32.8 KB  |  1,179 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 Compsys;
  24.  
  25. { Computer unit
  26.  
  27.   This form is the "acting" main form, even though Application.MainForm
  28.   actually points to the splash screen.  TComputer 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, Hooks,
  40.   Grids, Start, Apholder, ObjList, CalForm, DdeMan, Settings,
  41.   Sysmenu, Internet, ExtCtrls;
  42.  
  43. type
  44.   TComputer = 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.     DesktopMenu: TPopupMenu;
  54.     DeskProperties: TMenuItem;
  55.     DeskArrangeIcons: TMenuItem;
  56.     DeskClearDesktop: TMenuItem;
  57.     DeskCloseBrowsers: TMenuItem;
  58.     ConfigFileSystem: TMenuItem;
  59.     ConfigDesktop: TMenuItem;
  60.     ConfigStartMenu: TMenuItem;
  61.     ConfigBin: TMenuItem;
  62.     ConfigTaskbar: TMenuItem;
  63.     ObjectMenu: TPopupMenu;
  64.     Properties: TMenuItem;
  65.     CreateAlias: TMenuItem;
  66.     SysProperties: TMenuItem;
  67.     CascadeBrowsers: TMenuItem;
  68.     DeskLineUpIcons: TMenuItem;
  69.     N2: TMenuItem;
  70.     N3: TMenuItem;
  71.     N4: TMenuItem;
  72.     TopicSearch: TMenuItem;
  73.     N5: TMenuItem;
  74.     DeskFind: TMenuItem;
  75.     DeskRun: TMenuItem;
  76.     Run: TMenuItem;
  77.     DeskOpen: TMenuItem;
  78.     SystemMenu: TSystemMenu;
  79.     DeskExplore: TMenuItem;
  80.     MinimizePrograms: TMenuItem;
  81.     DeskArrange: TMenuItem;
  82.     New1: TMenuItem;
  83.     NewFileShort: TMenuItem;
  84.     NewFolderShort: TMenuItem;
  85.     NewNetShort: TMenuItem;
  86.     Open: TMenuItem;
  87.     BrowserLink: TBrowserLink;
  88.     Timer: TTimer;
  89.     NewDriveShort: TMenuItem;
  90.     DeskRepaint: TMenuItem;
  91.     Tipoftheday1: TMenuItem;
  92.     Help1: TMenuItem;
  93.     PROGMAN: TDdeServerConv;
  94.     procedure FormDestroy(Sender: TObject);
  95.     procedure FormResize(Sender: TObject);
  96.     procedure GridDblClick(Sender: TObject);
  97.     procedure CreateAliasClick(Sender: TObject);
  98.     procedure PropertiesClick(Sender: TObject);
  99.     procedure AboutClick(Sender: TObject);
  100.     procedure HelpContentsClick(Sender: TObject);
  101.     procedure FormCreate(Sender: TObject);
  102.     procedure FindClick(Sender: TObject);
  103.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  104.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  105.     procedure GridDrawCell(Sender: TObject; Index: Integer; Rect: TRect;
  106.       State: TGridDrawState);
  107.     procedure GridSelectCell(Sender: TObject; Index: Integer;
  108.       var CanSelect: Boolean);
  109.     procedure DropServerFileDrag(Sender: TObject; X, Y: Integer;
  110.       Target: Word; var Accept: Boolean);
  111.     procedure GridMouseDown(Sender: TObject; Button: TMouseButton;
  112.       Shift: TShiftState; X, Y: Integer);
  113.     procedure DropServerDeskDrop(Sender: TObject; X, Y: Integer;
  114.       Target: Word);
  115.     procedure AppException(Sender: TObject; E: Exception);
  116.     procedure AppShowHint(var HintStr: OpenString; var CanShow: Boolean;
  117.       var HintInfo: THintInfo);
  118.     procedure GridMouseMove(Sender: TObject; Shift: TShiftState; X,
  119.       Y: Integer);
  120.     procedure AppMessage(var Msg: TMsg; var Handled: Boolean);
  121.     procedure GridEndDrag(Sender, Target: TObject; X, Y: Integer);
  122.     procedure AppActivate(Sender: TObject);
  123.     procedure AppDeactivate(Sender: TObject);
  124.     procedure RefreshSysClick(Sender: TObject);
  125.     procedure FormPaint(Sender: TObject);
  126.     procedure DeskPropertiesClick(Sender: TObject);
  127.     procedure DeskArrangeIconsClick(Sender: TObject);
  128.     procedure DeskClearDesktopClick(Sender: TObject);
  129.     procedure DeskCloseBrowsersClick(Sender: TObject);
  130.     procedure ConfigDesktopClick(Sender: TObject);
  131.     procedure ConfigStartMenuClick(Sender: TObject);
  132.     procedure ConfigBinClick(Sender: TObject);
  133.     procedure ConfigTaskbarClick(Sender: TObject);
  134.     procedure ConfigFileSystemClick(Sender: TObject);
  135.     procedure ObjectMenuPopup(Sender: TObject);
  136.     procedure SysPropertiesClick(Sender: TObject);
  137.     procedure CascadeBrowsersClick(Sender: TObject);
  138.     procedure DeskLineUpIconsClick(Sender: TObject);
  139.     procedure TopicSearchClick(Sender: TObject);
  140.     function AppWndProc(var Message: TMessage): Boolean;
  141.     procedure DeskOpenClick(Sender: TObject);
  142.     procedure AppActiveFormChange(Sender: TObject);
  143.     procedure RunClick(Sender: TObject);
  144.     procedure DeskExploreClick(Sender: TObject);
  145.     procedure GridKeyDown(Sender: TObject; var Key: Word;
  146.       Shift: TShiftState);
  147.     procedure FormDragOver(Sender, Source: TObject; X, Y: Integer;
  148.       State: TDragState; var Accept: Boolean);
  149.     procedure FormDragDrop(Sender, Source: TObject; X, Y: Integer);
  150.     procedure MinimizeProgramsClick(Sender: TObject);
  151.     procedure NewNetShortClick(Sender: TObject);
  152.     procedure TimerTimer(Sender: TObject);
  153.     procedure DeskRepaintClick(Sender: TObject);
  154.     procedure Tipoftheday1Click(Sender: TObject);
  155.     procedure PROGMANExecuteMacro(Sender: TObject; Msg: TStrings);
  156.   private
  157.     { Private declarations }
  158.     Selected : TComputerIcon;
  159.     FItems : TObjectList;
  160.     procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND;
  161.     procedure WMCommand(var Msg: TWMCommand);   message WM_COMMAND;
  162.     procedure WMNCRButtonDown(var Msg: TWMNCRButtonDown); message WM_NCRBUTTONDOWN;
  163.     procedure WMDeskMenu(var Msg: TMessage); message WM_DESKMENU;
  164.     procedure WMDeskActivate(var Msg: TMessage); message WM_DESKACTIVATE;
  165.     procedure WMKeyboardHook(var Msg: TMessage); message WM_KEYBOARDHOOK;
  166.     procedure WMKeyboardAction(var Msg: TMessage); message WM_KEYBOARDACTION;
  167.   public
  168.     procedure Configure;
  169.     procedure ReadINISettings;
  170.     procedure SettingsChanged(Changes : TSettingChanges); override;
  171.     procedure ExecuteMacro(Sender : TObject; const macro: string; params: string);
  172.     procedure ExecuteScript(const filename: TFilename; EraseFile: Boolean);
  173.     property Items: TObjectList read FItems;
  174.   end;
  175.  
  176. const
  177.   { Custom system menu commands }
  178.  
  179.   SC_ARRANGEICONS    = SC_VSCROLL + 1024;
  180.   SC_CLEARDESKTOP    = SC_VSCROLL + 1056;
  181.   SC_CLOSEBROWSERS   = SC_VSCROLL + 1088;
  182.   SC_ABOUT           = SC_VSCROLL + 1120;
  183.   SC_CASCADEBROWSERS = SC_VSCROLL + 1152;
  184.   SC_LINEUPICONS     = SC_VSCROLL + 1184;
  185.   SC_PROPERTIES      = SC_VSCROLL + 1216;
  186.  
  187. var
  188.   Computer: TComputer;
  189.   LastErrorMode: Integer;
  190.   LastDeskClick: TPoint;
  191.  
  192. procedure KeyCommand(const title : string);
  193. function ProvideLastIcon(Instance : Word) : HIcon;
  194.  
  195. implementation
  196.  
  197. {$R *.DFM}
  198.  
  199. uses Desk, Shorts, DiskProp, Directry, About, IconWin, WinProcs, Drives,
  200.   FileFind, IniFiles, Resource, Strings, MiscUtil, Files, FileMan, Environs,
  201.   WasteBin, FileCtrl, Graphics, Tree, ShutDown, RunProg, Referenc, ChkList,
  202.   ShellAPI, StrtProp, DeskProp, TaskProp, SysProp, FSysProp, Clipbrd,
  203.   Tips, Locale, Task;
  204.  
  205. { This unit is responsible for opening various non-modal windows.
  206.   Inconsistencies will arise if non-modal icon windows are opened while
  207.   a modal dialog is showing, so the IsDialogModal function is used. }
  208.  
  209. function IsDialogModal : Boolean;
  210. begin
  211.   Result := not IsWindowEnabled(Application.MainForm.Handle);
  212. end;
  213.  
  214. function CheckDialogModal: Boolean;
  215. var Msg : string[79];
  216. begin
  217.   Result := IsDialogModal;
  218.   if Result then begin
  219.     if Screen.ActiveForm = nil then
  220.       Msg := LoadStr(SCloseUnnamedDialog)
  221.     else
  222.       Msg := FmtLoadStr(SCloseSpecificDialog, [Screen.ActiveForm.Caption]);
  223.     MsgDialog(Msg, mtInformation, [mbOK], 0);
  224.   end;
  225. end;
  226.  
  227.  
  228. procedure TComputer.FormDestroy(Sender: TObject);
  229. begin
  230.   ReleaseDesktopHook;
  231.   FItems.Free;
  232. end;
  233.  
  234.  
  235. procedure TComputer.FormResize(Sender: TObject);
  236. begin
  237.   Grid.Width := ClientWidth - 8;
  238.   Grid.Height := ClientHeight - 8;
  239.   Grid.SizeGrid;
  240.   Selected := nil;
  241.   Invalidate;
  242. end;
  243.  
  244.  
  245. procedure TComputer.GridDblClick(Sender: TObject);
  246. begin
  247.   if Selected <> nil then Selected.Open;
  248. end;
  249.  
  250.  
  251. procedure TComputer.CreateAliasClick(Sender: TObject);
  252. var
  253.   filename : TFilename;
  254. begin
  255.   if Selected is TDrive then
  256.     filename := 'c:\drive' + LowCase(TDrive(Selected).Letter) + AliasExtension
  257.   else
  258.     filename := ChangeFileExt(TProgram(Selected).Filename, AliasExtension);
  259.  
  260.   Selected.WriteAlias(Lowercase(filename));
  261. end;
  262.  
  263.  
  264. procedure TComputer.PropertiesClick(Sender: TObject);
  265. begin
  266.   if Selected is TDrive then DiskPropExecute(TDrive(Selected).Letter);
  267. end;
  268.  
  269.  
  270. procedure TComputer.AboutClick(Sender: TObject);
  271. begin
  272.   ShowModalDialog(TAboutBox);
  273. end;
  274.  
  275.  
  276. procedure TComputer.AppException(Sender: TObject; E: Exception);
  277. begin
  278.   { Use MessageDialog to display exception messages because
  279.     the forms look nicer in a small font }
  280.   MsgDialog(E.Message, mtError, [mbOK], E.HelpContext);
  281. end;
  282.  
  283.  
  284. procedure TComputer.WMSysCommand(var Msg: TWMSysCommand);
  285. begin
  286.   case Msg.CmdType and $FFF0 of
  287.     SC_RESTORE         : if SystemDrivesChanged then begin
  288.                            DetectDrives;
  289.                            RefreshSys.Click;
  290.                          end;
  291.     SC_ARRANGEICONS    : DeskArrange.Click;
  292.     SC_CLEARDESKTOP    : DeskClearDesktop.Click;
  293.     SC_CLOSEBROWSERS   : DeskCloseBrowsers.Click;
  294.     SC_ABOUT           : About.Click;
  295.     SC_CASCADEBROWSERS : CascadeBrowsers.Click;
  296.     SC_LINEUPICONS     : DeskLineUpIcons.Click;
  297.     SC_PROPERTIES      : SysProperties.Click;
  298.   end;
  299.   inherited;
  300. end;
  301.  
  302.  
  303. procedure TComputer.WMCommand(var Msg: TWMCommand);
  304. var item: TMenuItem;
  305. begin
  306.   item := StartMenu.FindItem(Msg.ItemID, fkCommand);
  307.   if item <> nil then item.Click;
  308.   inherited;
  309. end;
  310.  
  311.  
  312. procedure TComputer.HelpContentsClick(Sender: TObject);
  313. begin
  314.    Application.HelpJump('Contents');
  315. end;
  316.  
  317.  
  318. procedure TComputer.FormCreate(Sender: TObject);
  319. var
  320.   i: Integer;
  321. begin
  322.   if IsShell and ShellDDE then DdeMgr.AppName := 'PROGMAN';
  323.   Icon.Assign(Icons.Get('Computer'));
  324.  
  325.   FItems := TObjectList.Create;
  326.   AppActivate(self);
  327.  
  328.   with SystemMenu do begin
  329.     AddSeparator;
  330.     AddLoadStr(SMenuCascadeBrowsers, SC_CASCADEBROWSERS);
  331.     AddLoadStr(SMenuArrangeIcons, SC_ARRANGEICONS);
  332.     AddLoadStr(SMenuLineUpIcons, SC_LINEUPICONS);
  333.     AddLoadStr(SMenuCloseBrowsers, SC_CLOSEBROWSERS);
  334.     AddLoadStr(SMenuClearDesktop, SC_CLEARDESKTOP);
  335.     AddSeparator;
  336.     AddLoadStr(SMenuProperties, SC_PROPERTIES);
  337.     AddLoadStr(SMenuAbout, SC_ABOUT);
  338.     DeleteCommand(SC_SIZE);
  339.   end;
  340.  
  341.   StartMenu.OnStartMacro := ExecuteMacro;
  342.  
  343.   ReadINISettings;
  344.   Configure;
  345.   LoadMinPosition(ini, 'Computer');
  346.   LoadPosition(ini, 'Computer');
  347.   Resize;
  348.   Update;
  349. end;
  350.  
  351. procedure TComputer.ReadINISettings;
  352. begin
  353.   RefreshSys.Click;
  354. end;
  355.  
  356.  
  357. procedure TComputer.Configure;
  358. begin
  359.   Caption := ComputerCaption;
  360.   Color := Colors[ccWinFrame];
  361.   Font.Assign(GlobalFont);
  362.  
  363.   with Grid do begin
  364.     Visible := False;
  365.     Color := Colors[ccIconBack];
  366.     SelColor := Colors[ccIconSel];
  367.     DefaultColWidth := BrowseGrid.X;
  368.     DefaultRowHeight := BrowseGrid.Y;
  369.     Font.Assign(GlobalFont);
  370.     Canvas.Font.Assign(Font);
  371.     Visible := True;
  372.   end;
  373.  
  374.   MinimumWidth := 128;
  375.   MinimumHeight := 64;
  376.  
  377.   if ShowDeskMenu then SetDesktopHook(Handle)
  378.   else ReleaseDesktopHook;
  379.  
  380.   if GlobalHotkeys then SetKeyboardHook(Handle)
  381.   else ReleaseKeyboardHook;
  382.  
  383.   SetRCloseEnabled(RightClose);
  384.   SetRButtonUpClose(RButtonUpClose);
  385.  
  386.   BrowserLink.ServiceApplication :=
  387.     ini.ReadString('Internet', 'ServiceApplication', '');
  388.  
  389.   Timer.Interval := DosTimerInterval;  
  390.   Timer.Enabled := EnableDosScripts;
  391. end;
  392.  
  393.  
  394. procedure TComputer.FindClick(Sender: TObject);
  395. begin
  396.   if CheckDialogModal then Exit;
  397.   FileFindExecute('');
  398. end;
  399.  
  400.  
  401. procedure TComputer.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  402. begin
  403.   if SysWinQuit then begin
  404.     { save the desktop before it's too late! }
  405.     Desktop.Save;
  406.  
  407.     if IsShell then begin
  408.       { Always ask before a shell is closed down.  The InSendMessage is
  409.         there for a reason: a slight problem arises when Windows Setup tries
  410.         to restart Windows -- the call to ExitWindows returns false, so
  411.         Calmira doesn't quit and Setup backs off.  The trick is to detect
  412.         when Setup is the "caller" using InSendMessage
  413.       }
  414.  
  415.       CanClose := MsgDialogRes(SNotifyEndWindows,
  416.         mtInformation, [mbOK, mbCancel], 0) = mrOK;
  417.  
  418.       if CanClose and not InSendMessage then CanClose := Bool(ExitWindows(0, 0));
  419.     end
  420.  
  421.     else
  422.       CanClose := not QueryQuit or
  423.        (MsgDialogRes(SQueryQuit, mtConfirmation, [mbYes, mbNo], 0) = mrYes);
  424.   end;
  425. end;
  426.  
  427. procedure TComputer.FormClose(Sender: TObject; var Action: TCloseAction);
  428. begin
  429.   if SysWinQuit then Application.Terminate
  430.   else Action := caMinimize;
  431. end;
  432.  
  433.  
  434. procedure TComputer.WMNCRButtonDown(var Msg: TWMNCRButtonDown);
  435. begin
  436.   with Msg do
  437.     if (WindowState = wsMinimized) then
  438.       if (HitTest = HTSYSMENU) or CompIconStart then
  439.         StartMenu.Popup(XCursor, YCursor, False)
  440.       else
  441.         WindowMenu.Popup(XCursor, YCursor)
  442.     else
  443.       inherited;
  444. end;
  445.  
  446.  
  447. procedure TComputer.GridDrawCell(Sender: TObject; Index: Integer;
  448.   Rect: TRect; State: TGridDrawState);
  449. begin
  450.   if Index < FItems.Count then TComputerIcon(FItems[Index]).Draw(Grid.Canvas, Rect);
  451. end;
  452.  
  453.  
  454. procedure TComputer.GridSelectCell(Sender: TObject; Index: Integer;
  455.   var CanSelect: Boolean);
  456. begin
  457.    CanSelect := Index < FItems.Count;
  458.    if CanSelect then Selected := TComputerIcon(FItems[Index]) else Selected := nil;
  459. end;
  460.  
  461.  
  462. procedure TComputer.DropServerFileDrag(Sender: TObject; X, Y: Integer;
  463.   Target: Word; var Accept: Boolean);
  464. begin
  465.   Accept := Target = GetDesktopWindow;
  466. end;
  467.  
  468.  
  469. procedure TComputer.GridMouseDown(Sender: TObject; Button: TMouseButton;
  470.   Shift: TShiftState; X, Y: Integer);
  471. var
  472.   i: Integer;
  473.   p: TPoint;
  474.   rect : TRect;
  475. begin
  476.   if Button = mbLeft then begin
  477.     if Selected <> nil then Grid.BeginDrag(False)
  478.   end
  479.   else if not Grid.Dragging then begin
  480.     { popup one of the menus depending on whether the cursor
  481.       is directly over an icon }
  482.     i := Grid.MouseToCell(X, Y);
  483.     rect := Grid.CellBounds(i);
  484.     InflateRect(rect, -16, -8);
  485.     OffsetRect(rect, 0, -8);
  486.     GetCursorPos(p);
  487.  
  488.     if PtInRect(rect, Point(x, y)) and (i < Items.Count) then begin
  489.       Grid.Select(i);
  490.       ObjectMenu.Popup(p.x, p.y)
  491.     end                
  492.     else
  493.       WindowMenu.Popup(p.X, p.Y);
  494.   end;
  495. end;
  496.  
  497.  
  498. procedure TComputer.DropServerDeskDrop(Sender: TObject; X, Y: Integer;
  499.   Target: Word);
  500. begin
  501.   Selected.CreateShortcut.MinPosition := Point(X - 16, Y - 16);
  502. end;
  503.  
  504.  
  505. procedure TComputer.AppShowHint(var HintStr: OpenString;
  506.   var CanShow: Boolean; var HintInfo: THintInfo);
  507. var
  508.   f : TDirItem;
  509.   w : TIconWindow;
  510.   i : Integer;
  511. begin
  512.   { Handles popup file hints.  A hint is shown only when there
  513.     is no dragging taking place, otherwise the hint window will
  514.     interfere with the focus rect.  The hint is shown slightly
  515.     above the cursor and is forced to hide or change once the
  516.     cursor leaves the current cell.
  517.   }
  518.  
  519.   with HintInfo do
  520.     if (HintControl is TMultiGrid) and FileHints then
  521.       with TMultiGrid(HintControl) do begin
  522.         if not (Owner is TIconWindow) then Exit;
  523.         w := TIconWindow(Owner);
  524.         if (GetCaptureControl <> nil) or w.ViewList.Checked then Exit;
  525.         f := w.FileAt(CursorPos.X, CursorPos.Y, True);
  526.         CanShow := f <> nil;
  527.         if not CanShow then Exit;
  528.         CursorRect := CellBounds(MouseToCell(CursorPos.X, CursorPos.Y));
  529.         with ClientToScreen(CursorPos) do HintPos := Point(X, Y - 24);
  530.         HintStr := f.Hint;
  531.       end
  532.  
  533.     else if HintControl is TCheckList then
  534.       with TCheckList(HintControl) do begin
  535.         i := ItemAtPos(CursorPos, False);
  536.         if (i < 0) or (i >= Hints.Count) then Exit;
  537.         HintStr := Hints[i];
  538.         CursorRect := ItemRect(i);
  539.       end;
  540. end;
  541.  
  542.  
  543. procedure TComputer.GridMouseMove(Sender: TObject; Shift: TShiftState; X,
  544.   Y: Integer);
  545. begin
  546.   if Grid.Dragging and DropServer.CanDrop and AnimCursor then
  547.     SetCursor(Screen.Cursors[crFlutter])
  548. end;
  549.  
  550.  
  551. function EnumTitleProc(Wnd : HWND; caption: PString):Bool; export;
  552. var
  553.   buf: TCaption;
  554. begin
  555.   Result := True;
  556.   buf[0] := Chr(GetWindowText(Wnd, @buf[1], 78));
  557.   if CompareText(buf, caption^) = 0 then begin
  558.     SendMessage(Wnd, WM_ACTIVATE, WA_ACTIVE, MakeLong(Wnd, Word(True)));
  559.     if IsIconic(Wnd) then ShowWindow(Wnd, SW_RESTORE)
  560.     else BringWindowToTop(Wnd);
  561.     Result := False;
  562.   end
  563. end;
  564.  
  565.  
  566. procedure KeyCommand(const title : string);
  567. var
  568.   i : Integer;
  569.   f : TForm;
  570.   item : TMenuItem;
  571.   p : TPoint;
  572. begin
  573.   { First look for a matching form caption }
  574.   with Screen do
  575.   for i := 0 to FormCount-1 do begin
  576.     f := Forms[i];
  577.     if CompareText(f.Caption, title) = 0 then begin
  578.       if f is TShort then
  579.         f.Perform(WM_OPENSHORT, 0, 0)
  580.       else if f.Visible and f.Enabled then begin
  581.         f.WindowState := wsNormal;
  582.         f.BringToFront;
  583.       end;
  584.       Exit;
  585.     end;
  586.   end;
  587.  
  588.   item := StartMenu.Find(title, miAll);
  589.   if item <> nil then begin
  590.     if item.Count = 0 then item.Click
  591.     else begin
  592.       GetCursorPos(p);
  593.       StartMenu.PopupMenuItem(item.Handle, p.x, p.y, True);
  594.     end
  595.   end
  596.   else if CouldBeFolder(title) and HDirectoryExists(title) then
  597.     Desktop.OpenFolder(title)
  598.   else if CompareText(title, 'Start') = 0 then
  599.     Taskbar.StartKeyPopup
  600.   else
  601.     EnumWindows(@EnumTitleProc, Longint(@title));
  602. end;
  603.  
  604.  
  605. procedure TComputer.WMKeyboardHook(var Msg: TMessage);
  606. var
  607.   i: Integer;
  608. begin
  609.   i := KeyMaps.IndexOfObject(
  610.     TObject(Shortcut(Msg.wParam, KeyDataToShiftState(Msg.lParam))));
  611.   Msg.Result := Integer(i > -1);
  612.  
  613.   if Msg.Result > 0 then PostMessage(Handle, WM_KEYBOARDACTION, i, 0);
  614. end;
  615.  
  616.  
  617. procedure TComputer.WMKeyboardAction(var Msg: TMessage);
  618. begin
  619.   if not IsDialogModal then
  620.   try
  621.     KeyCommand(KeyMaps[Msg.wParam]);
  622.   except
  623.     on E: Exception do Application.HandleException(E);
  624.   end;
  625. end;
  626.  
  627.  
  628. procedure TComputer.AppMessage(var Msg: TMsg; var Handled: Boolean);
  629. begin
  630.   with Msg do
  631.     case Message of
  632.     WM_CLOSE:
  633.       if Msg.HWnd = Application.Handle then begin
  634.         Handled := True;
  635.         Desktop.Save;
  636.         if IsShell and (MsgDialogRes(SNotifyEndWindows,
  637.           mtInformation, [mbOK, mbCancel], 0) = mrOK) then ExitWindows(0, 0);
  638.       end;
  639.  
  640.     WM_DROPFILES :
  641.       TDropClient.CheckMessage(Msg, Handled);
  642.  
  643.     WM_KEYDOWN :
  644.       { Check for keyboard shortcuts.  Exceptions must be handled explicitly,
  645.         otherwise the program will be terminated by the Delphi RTL }
  646.  
  647.       if not IsDialogModal then
  648.         if (Msg.wParam = VK_TAB) and (GetKeyState(VK_CONTROL) < 0) then
  649.           try Desktop.NextForm
  650.           except on E: Exception do Application.HandleException(E);
  651.           end
  652.         else if not GlobalHotKeys and IsHotKey(Msg.wParam, Msg.lParam) then
  653.           Perform(WM_KEYBOARDHOOK, Msg.wParam, Msg.lParam);
  654.  
  655.     $C000..$FFFF : { registered messages }
  656.       if Message = WM_CALMIRA then begin
  657.         case wParam of
  658.           CM_PREVINSTANCE: begin
  659.                              BringToFront;
  660.                              WindowState := wsNormal;
  661.                            end;
  662.           CM_EXPLORER    : OpenExplorer('');
  663.           CM_RELOADOPTIONS : SettingsChanged([scSystem, scFileSystem, scDesktop,
  664.                               scStartMenu, scBin, scTaskbar, scDisplay,
  665.                               scINIFile, sc4DOS, scDevices]);
  666.         end;
  667.         Handled := True;
  668.       end;
  669.     end;
  670. end;
  671.  
  672.  
  673.  
  674. procedure TComputer.GridEndDrag(Sender, Target: TObject; X, Y: Integer);
  675. begin
  676.   DropServer.DragFinished;
  677. end;
  678.  
  679. procedure ExecuteFolderMacro(mode: Integer; params: string);
  680. var
  681.   foldername: TFilename;
  682.   filespec : string[12];
  683.   IconWindow : TIconWindow;
  684. begin
  685.   MacroDisplayMode := mode;
  686.  
  687.   if params = '' then begin
  688.     if not InputQuery(LoadStr(SOpenFolder),
  689.       LoadStr(SFolderName), params) then Exit;
  690.     params := Lowercase(ExpandFoldername(EnvironSubst(params), Winpath[1]));
  691.   end;
  692.  
  693.   if (Pos('*', params) > 0) or (Pos('?', params) > 0) then begin
  694.     filespec := ExtractFilename(params);
  695.     foldername := ExtractFileDir(params);
  696.   end
  697.   else begin
  698.     filespec := DefaultFilter;
  699.     foldername := params;
  700.   end;
  701.  
  702.   if ConfirmFolder(foldername) <> mrYes then Exit;
  703.  
  704.   IconWindow := Desktop.WindowOf(foldername);
  705.   if IconWindow = nil then
  706.     TIconWindow.Init(Application,
  707.       Lowercase(foldername), Lowercase(filespec)).Show
  708.   else with IconWindow do begin
  709.     Dir.Filter := filespec;
  710.     RefreshWin;
  711.     ShowNormal;
  712.   end;
  713. end;
  714.  
  715. const
  716.   MacroList : array[0..20] of PChar =
  717.     ({0}'$Folder',
  718.      {1}'$System',
  719.      {2}'$Run',
  720.      {3}'$Explore',
  721.      {4}'$Find',
  722.      {5}'$Shutdown',
  723.      {6}'$SystemProp',
  724.      {7}'$DesktopProp',
  725.      {8}'$FileSystemProp',
  726.      {9}'$TaskbarProp',
  727.      {10}'$BinProp',
  728.      {11}'$StartMenuProp',
  729.      {12}'$CascadeBrowsers',
  730.      {13}'$ArrangeIcons',
  731.      {14}'$LineUpIcons',
  732.      {15}'$CloseBrowsers',
  733.      {16}'$ClearDesktop',
  734.      {17}'$MinimizePrograms',
  735.      {18}'$LargeIconFolder',
  736.      {19}'$SmallIconFolder',
  737.      {20}'$ListFolder');
  738.  
  739. function FindCommand(const Cmds : array of PChar; const s: string): Integer;
  740. var buf: array[0..255] of Char;
  741. begin
  742.   for Result := 0 to High(Cmds) do
  743.     if StrIComp(Cmds[Result], StrPCopy(buf, s)) = 0 then Exit;
  744.   Result := -1;
  745. end;
  746.  
  747. procedure TComputer.ExecuteMacro(Sender : TObject; const macro: string; params : string);
  748. var
  749.   CommandID : Integer;
  750. begin
  751.   if CheckDialogModal then Exit;
  752.  
  753.   CommandID := FindCommand(MacroList, macro);
  754.  
  755.   case CommandID of
  756.    0: ExecuteFolderMacro(0, params);
  757.    1: ShowNormal;
  758.    2: RunExecute('', '');
  759.    3: OpenExplorer(params);
  760.    4: Find.Click;
  761.    5: ShowModalDialog(TQuitDlg);
  762.    6: SysProperties.Click;
  763.    7: ConfigDesktop.Click;
  764.    8: ConfigFileSystem.Click;
  765.    9: ConfigTaskbar.Click;
  766.    10: ConfigBin.Click;
  767.    11: ConfigStartMenu.Click;
  768.    12..17 : DeskArrange.Items[CommandID-12].Click;
  769.    18..20 : ExecuteFolderMacro(CommandID - 17, params);
  770.   else
  771.     MsgDialogResFmt(SUnknownCommand, [macro], mtError, [mbOK], 0);
  772.   end;
  773. end;
  774.  
  775.  
  776. function ProvideLastIcon(Instance : Word) : HIcon;
  777. begin
  778.   { If the last program the user executed matches the given instance
  779.     handle, then an icon is extracted if the user specified a
  780.     particular one }
  781.  
  782.   Result := 0;
  783.  
  784.   if Instance = LastInstance then begin
  785.     if LastIconFile > '' then
  786.       Result := ExtractIcon(HInstance, StringAsPChar(LastIconFile), LastIconIndex);
  787.     LastInstance := 0;
  788.     LastIconFile := '';
  789.     LastIconIndex := 0;
  790.   end;
  791. end;
  792.  
  793.  
  794. procedure TComputer.AppActivate(Sender: TObject);
  795. begin
  796.   LastErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
  797. end;
  798.  
  799. procedure TComputer.AppDeactivate(Sender: TObject);
  800. begin
  801.   SetErrorMode(LastErrorMode);
  802. end;
  803.  
  804.  
  805. procedure TComputer.RefreshSysClick(Sender: TObject);
  806. var
  807.   drive : Char;
  808.   progs : TStringList;
  809.   i: Integer;
  810.   progname : TFilename;
  811.   p : TProgram;
  812. begin
  813.   Selected := nil;
  814.   FItems.ClearObjects;
  815.   DetectDrives;
  816.  
  817.   { Add the disk drives }
  818.   for drive := 'A' to 'Z' do
  819.     if drive in ValidDrives then FItems.Add(TDrive.Create(drive));
  820.  
  821.   { Add the program "shortcuts" }
  822.   progs := TStringList.Create;
  823.   try
  824.     ini.ReadSection('Programs', progs);
  825.  
  826.     for i := 0 to progs.Count-1 do begin
  827.       progname := EnvironSubst(progs[i]);
  828.       if FileExists(progname) then begin
  829.         p := TProgram.Create(progname);
  830.         p.Caption := ini.ReadString('Programs', progs[i], ExtractFilename(progs[i]));
  831.         FItems.Add(p);
  832.       end;
  833.     end;
  834.   finally
  835.     progs.Free;
  836.   end;
  837.  
  838.   with Grid do begin
  839.     Reset;
  840.     Limit := FItems.Count;
  841.     SizeGrid;
  842.     Focus := 0;
  843.   end;
  844.   Invalidate;
  845. end;
  846.  
  847.  
  848. procedure TComputer.FormPaint(Sender: TObject);
  849. begin
  850.   Border3D(Canvas, ClientWidth-1, ClientHeight-1);
  851. end;
  852.  
  853.  
  854. procedure TComputer.WMDeskMenu(var Msg: TMessage);
  855. begin
  856.   LastDeskClick := TPoint(Msg.lParam);
  857.   with TPoint(Msg.lParam) do DesktopMenu.Popup(X, Y);
  858. end;
  859.  
  860.  
  861. procedure TComputer.DeskPropertiesClick(Sender: TObject);
  862. begin
  863.   ConfigDesktop.Click;
  864. end;
  865.  
  866.  
  867. procedure TComputer.DeskArrangeIconsClick(Sender: TObject);
  868. begin
  869.   Desktop.ArrangeIcons;
  870. end;
  871.  
  872.  
  873. procedure TComputer.DeskClearDesktopClick(Sender: TObject);
  874. begin
  875.   if not (CheckDialogModal or DesktopParent) then Application.Minimize;
  876. end;
  877.  
  878.  
  879. procedure TComputer.DeskCloseBrowsersClick(Sender: TObject);
  880. begin
  881.   if not CheckDialogModal then Desktop.CloseWindows;
  882. end;
  883.  
  884.  
  885. procedure TComputer.ConfigDesktopClick(Sender: TObject);
  886. begin
  887.   if not CheckDialogModal then ShowModalDialog(TDeskPropDlg);
  888. end;
  889.  
  890.  
  891. procedure TComputer.ConfigStartMenuClick(Sender: TObject);
  892. begin
  893.   if CheckDialogModal then Exit;
  894.   ShowHourglass;
  895.   if StartPropDlg = nil then
  896.     StartPropDlg := TStartPropDlg.Create(Application);
  897.   StartPropDlg.Show;
  898. end;
  899.  
  900.  
  901. procedure TComputer.ConfigBinClick(Sender: TObject);
  902. begin
  903.   Bin.Properties.Click;
  904. end;
  905.  
  906.  
  907. procedure TComputer.ConfigTaskbarClick(Sender: TObject);
  908. begin
  909.   ShowModalDialog(TTaskPropDlg);
  910. end;
  911.  
  912.  
  913. procedure TComputer.ConfigFileSystemClick(Sender: TObject);
  914. begin
  915.   ShowModalDialog(TFileSysPropDlg);
  916. end;
  917.  
  918.  
  919. procedure TComputer.ObjectMenuPopup(Sender: TObject);
  920. begin
  921.   CreateAlias.Enabled := Selected <> nil;
  922.   Properties.Enabled := Selected is TDrive;
  923. end;
  924.  
  925.  
  926. procedure TComputer.SysPropertiesClick(Sender: TObject);
  927. begin
  928.   ShowModalDialog(TSysPropDlg);
  929. end;
  930.  
  931.  
  932. procedure TComputer.CascadeBrowsersClick(Sender: TObject);
  933. begin
  934.   if not CheckDialogModal then Desktop.Cascade;
  935. end;
  936.  
  937.  
  938. procedure TComputer.DeskLineUpIconsClick(Sender: TObject);
  939. begin
  940.   Desktop.SnapToGrid;
  941. end;
  942.  
  943.  
  944. procedure TComputer.TopicSearchClick(Sender: TObject);
  945. const
  946.   EmptyString : PChar = '';
  947. begin
  948.   Application.HelpCommand(HELP_PARTIALKEY, Longint(EmptyString));
  949. end;
  950.  
  951.  
  952. function TComputer.AppWndProc(var Message: TMessage): Boolean;
  953. begin
  954.   Result := False;
  955.   with Message do
  956.     if (Msg = WM_ENDSESSION) and Bool(wParam) then Desktop.Save;
  957. end;
  958.  
  959.  
  960. procedure TComputer.SettingsChanged(Changes : TSettingChanges);
  961. begin
  962.   if [scSystem, scFileSystem, scDesktop, scDisplay] * Changes <> [] then
  963.     Configure;
  964.  
  965.   if [scDevices, scINIFile] * Changes <> [] then RefreshSys.Click;
  966. end;
  967.  
  968.  
  969. procedure TComputer.DeskOpenClick(Sender: TObject);
  970. begin
  971.   if CheckDialogModal then Exit;
  972.   ExecuteMacro(self, '$Folder', '');
  973. end;
  974.  
  975.  
  976. procedure TComputer.AppActiveFormChange(Sender: TObject);
  977. var s: TCaption;
  978. begin
  979.   if ComponentState <> [] then Exit;
  980.  
  981.   if Screen.ActiveForm is TIconWindow then begin
  982.     s := TIconWindow(Screen.ActiveForm).Dir.Fullname;
  983.     Environment.Values['CURRENTFOLDER'] := s;
  984.     Environment.Values['CURRENTDRIVE'] := s[1];
  985.   end
  986.   else begin
  987.     Environment.Values['CURRENTFOLDER'] := '';
  988.     Environment.Values['CURRENTDRIVE'] := '';
  989.   end;
  990. end;
  991.  
  992.  
  993. procedure TComputer.RunClick(Sender: TObject);
  994. begin
  995.   if not CheckDialogModal then RunExecute('', '');
  996. end;
  997.  
  998. procedure TComputer.DeskExploreClick(Sender: TObject);
  999. begin
  1000.   if not CheckDialogModal then OpenExplorer('');
  1001. end;
  1002.  
  1003. procedure TComputer.GridKeyDown(Sender: TObject; var Key: Word;
  1004.   Shift: TShiftState);
  1005. var
  1006.   item: TMenuItem;
  1007. begin
  1008.   item := WindowMenu.FindItem(Shortcut(Key, Shift), fkShortcut);
  1009.   if item <> nil then item.Click;
  1010. end;
  1011.  
  1012. procedure TComputer.FormDragOver(Sender, Source: TObject; X, Y: Integer;
  1013.   State: TDragState; var Accept: Boolean);
  1014. begin
  1015.   Accept := (Source is TMultiGrid) and (TMultiGrid(Source).Owner is TIconWindow);
  1016. end;
  1017.  
  1018. procedure TComputer.FormDragDrop(Sender, Source: TObject; X, Y: Integer);
  1019. var i: Integer;
  1020. begin
  1021.   with ((Source as TMultiGrid).Owner as TIconWindow).CompileSelection(False) do
  1022.     for i := 0 to Count-1 do
  1023.       with  TDirItem(Items[i]) do
  1024.         NewStartItems.Values[GetTitle] := GetStartInfo;
  1025. end;
  1026.  
  1027. procedure TComputer.MinimizeProgramsClick(Sender: TObject);
  1028. begin
  1029.   Taskbar.MinimizeAll;
  1030. end;
  1031.  
  1032.  
  1033. procedure TComputer.WMDeskActivate(var Msg: TMessage);
  1034. begin
  1035.   with Application do begin
  1036.     if IsIconic(Handle) then ShowWindow(Handle, SW_RESTORE)
  1037.     else begin
  1038.       if Active then begin
  1039.         if CheckDialogModal then Exit
  1040.         else WindowState := wsNormal;
  1041.       end
  1042.       else BringWindowToTop(Handle);
  1043.     end;
  1044.   end;
  1045.  
  1046.   if IsWindowEnabled(Handle) then BringToFront;
  1047. end;
  1048.  
  1049.  
  1050.  
  1051. procedure TComputer.NewNetShortClick(Sender: TObject);
  1052. begin
  1053.   with TShort.Create(Application) do begin
  1054.     Ref.Kind := TReferenceKind((Sender as TComponent).Tag);
  1055.     if Ref.AssignFromExternal then begin
  1056.       Caption := Ref.Caption;
  1057.       Ref.AssignIcon(Icon);
  1058.       MinPosition := LastDeskClick;
  1059.     end
  1060.     else Free;
  1061.   end;
  1062. end;
  1063.  
  1064.  
  1065.  
  1066. const
  1067.   RunningScript : Boolean = False;
  1068.  
  1069.  
  1070. procedure TComputer.ExecuteScript(const filename: TFilename; EraseFile: Boolean);
  1071. var
  1072.   lines : TStringList;
  1073.   next : Integer;
  1074.  
  1075. procedure ProcessStart;
  1076. var
  1077.   dir : TFilename;
  1078.   command : string;
  1079.   i : Integer;
  1080. begin
  1081.   dir := lines[next];
  1082.   i := next + 1;
  1083.   while (i < lines.Count) and (lines[i] <> '') do begin
  1084.     command := lines[i];
  1085.     DefaultExec(Lowercase(GetWord(command, ' ')), command, dir, SW_SHOW);
  1086.     Inc(i);
  1087.   end;
  1088.   next := i;
  1089. end;
  1090.  
  1091. const
  1092.   ScriptCmds : array[0..4] of PChar =
  1093.    ('Explore', 'Folder', 'Start', 'Activate', 'Macro');
  1094.  
  1095. var
  1096.   s : string;
  1097.   currentdir : TFilename;
  1098.   i : Integer;
  1099. begin
  1100.   if RunningScript then Exit;
  1101.  
  1102.   RunningScript := True;
  1103.   lines := TStringList.Create;
  1104.   try
  1105.     lines.LoadFromFile(filename);
  1106.     if EraseFile then DeleteFile(filename);
  1107.     for i := 0 to lines.Count-1 do lines[i] := Trim(lines[i]);
  1108.  
  1109.     next := 0;
  1110.  
  1111.     while next < lines.Count do begin
  1112.       s := lines[next];
  1113.       if s > '' then Inc(next);
  1114.  
  1115.       case FindCommand(ScriptCmds, s) of
  1116.        0: OpenExplorer(Lowercase(lines[next]));
  1117.        1: begin
  1118.             currentdir := Lowercase(lines[next]);
  1119.             Inc(next);
  1120.             s := Lowercase(lines[next]);
  1121.             if CouldBeFolder(s) then Desktop.OpenFolder(s)
  1122.             else if (s > '') and (s[1] in Alphas) then
  1123.               Desktop.OpenFolder(MakePath(currentdir) + s)
  1124.             else
  1125.               Desktop.OpenFolder(ExpandFoldername(s, currentdir[1]));
  1126.           end;
  1127.        2: ProcessStart;
  1128.        3: KeyCommand(lines[next]);
  1129.        4: begin
  1130.             s := lines[next];
  1131.             ExecuteMacro(self, GetWord(s, ' '), s);
  1132.           end;
  1133.       end;
  1134.  
  1135.       Inc(next);
  1136.     end;
  1137.   finally
  1138.     lines.Free;
  1139.     RunningScript := False;
  1140.   end;
  1141. end;
  1142.  
  1143.  
  1144.  
  1145. procedure TComputer.TimerTimer(Sender: TObject);
  1146. var
  1147.   h : Integer;
  1148. begin
  1149.   if not RunningScript and FileExists(DOSScriptFilename) then
  1150.     if not IsDialogModal then begin
  1151.       h := FileOpen(DosScriptFilename, fmShareDenyWrite);
  1152.       if h > 0 then begin
  1153.         FileClose(h);
  1154.         ExecuteScript(DOSScriptFilename, True);
  1155.       end;
  1156.     end
  1157.     else MessageBeep(0);
  1158. end;
  1159.  
  1160.  
  1161. procedure TComputer.DeskRepaintClick(Sender: TObject);
  1162. begin
  1163.   RedrawWindow(0, nil, 0, RDW_ERASE or RDW_FRAME or RDW_ALLCHILDREN or
  1164.     RDW_INTERNALPAINT or RDW_INVALIDATE or RDW_ERASENOW or RDW_UPDATENOW);
  1165. end;
  1166.  
  1167. procedure TComputer.Tipoftheday1Click(Sender: TObject);
  1168. begin
  1169.    ShowModalDialog(TTipDialog);
  1170. end;
  1171.  
  1172.  
  1173. procedure TComputer.PROGMANExecuteMacro(Sender: TObject; Msg: TStrings);
  1174. begin
  1175.   ShellDDEBuf.AddStrings(Msg);
  1176. end;
  1177.  
  1178. end.
  1179.