home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1998 April A / Pcwk4a98.iso / PROGRAM / DELPHI16 / Calmira / Src / SRC / TASK.PAS < prev    next >
Pascal/Delphi Source File  |  1997-02-15  |  38KB  |  1,408 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 Task;
  24.  
  25. interface
  26.  
  27. uses
  28.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  29.   Forms, Buttons, ExtCtrls, Stylsped, Menus, CalMsgs, StdCtrls;
  30.  
  31. const
  32.   WM_ADDBUTTON = WM_USER + 250;
  33.  
  34. type
  35.   TWindowType = (wtGeneral, wtIconWindow, wtExplorer);
  36.  
  37.   TTaskButton = class(TStyleSpeed)
  38.   private
  39.     FWindow : HWnd;
  40.     FTask   : THandle;
  41.     FWindowType : TWindowType;
  42.     procedure SetWindow(value : HWND);
  43.   public
  44.     constructor Create(AOwner : TComponent); override;
  45.     procedure RefreshCaption;
  46.     procedure AssignGlyph;
  47.     function MinimizeCaption(s : string): string;
  48.     property Window : HWND read FWindow write SetWindow;
  49.     property Task : THandle read FTask;
  50.     property WindowType : TWindowType read FWindowType;
  51.   end;
  52.  
  53.  
  54.   TButtonList = class(TList)
  55.   private
  56.     function GetButtons(i: Integer): TTaskButton;
  57.   public
  58.     property Buttons[i: Integer]: TTaskButton read GetButtons;
  59.   end;
  60.  
  61.  
  62.   TTrayProgram = class(TGraphicControl)
  63.   private
  64.     FGlyph : TBitmap;
  65.     FModuleFile : TFilename;
  66.   protected
  67.     procedure Paint; override;
  68.   public
  69.     constructor Create(AOwner : TComponent); override;
  70.     destructor Destroy; override;
  71.     procedure SetProgram(const filename: TFilename);
  72.     procedure Click; override;
  73.   end;
  74.  
  75.  
  76.   TBar = class(TForm)
  77.     TaskMenu: TPopupMenu;
  78.     Restore: TMenuItem;
  79.     Minimize: TMenuItem;
  80.     Maximize: TMenuItem;
  81.     CloseItem: TMenuItem;
  82.     StartBtn: TStyleSpeed;
  83.     SysMenu: TPopupMenu;
  84.     Terminate: TMenuItem;
  85.     Quit: TMenuItem;
  86.     Timer: TTimer;
  87.     Clock: TPanel;
  88.     Stay: TMenuItem;
  89.     HideBar: TMenuItem;
  90.     HintTimer: TTimer;
  91.     Spy: TMenuItem;
  92.     N2: TMenuItem;
  93.     Properties1: TMenuItem;
  94.     Startproperties1: TMenuItem;
  95.     N1: TMenuItem;
  96.     procedure FormCreate(Sender: TObject);
  97.     procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  98.       Y: Integer);
  99.     procedure FormDeactivate(Sender: TObject);
  100.     procedure FormPaint(Sender: TObject);
  101.     procedure FormDestroy(Sender: TObject);
  102.     procedure StartBtnClick(Sender: TObject);
  103.     procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
  104.       Shift: TShiftState; X, Y: Integer);
  105.     procedure RestoreClick(Sender: TObject);
  106.     procedure MinimizeClick(Sender: TObject);
  107.     procedure MaximizeClick(Sender: TObject);
  108.     procedure CloseItemClick(Sender: TObject);
  109.     procedure TaskMenuPopup(Sender: TObject);
  110.     procedure TerminateClick(Sender: TObject);
  111.     procedure StartBtnMouseDown(Sender: TObject; Button: TMouseButton;
  112.       Shift: TShiftState; X, Y: Integer);
  113.     procedure QuitClick(Sender: TObject);
  114.     procedure SysMenuPopup(Sender: TObject);
  115.     procedure FormResize(Sender: TObject);
  116.     procedure TimerTimer(Sender: TObject);
  117.     procedure ClockMouseDown(Sender: TObject; Button: TMouseButton;
  118.       Shift: TShiftState; X, Y: Integer);
  119.     procedure ClockMouseUp(Sender: TObject; Button: TMouseButton;
  120.       Shift: TShiftState; X, Y: Integer);
  121.     procedure ClockMouseMove(Sender: TObject; Shift: TShiftState; X,
  122.       Y: Integer);
  123.     procedure StayClick(Sender: TObject);
  124.     procedure HideBarClick(Sender: TObject);
  125.     procedure HintTimerTimer(Sender: TObject);
  126.     procedure SpyClick(Sender: TObject);
  127.     procedure Startproperties1Click(Sender: TObject);
  128.     procedure Properties1Click(Sender: TObject);
  129.   private
  130.     { Private declarations }
  131.     BarShowing    : Boolean;
  132.     ButtonList    : TButtonList;
  133.     Excludes      : TStringList;
  134.     HintWindow    : THintWindow;
  135.     HintControl   : TControl;
  136.     Pressed       : Integer;
  137.     InTaskClick   : Boolean;
  138.     HiddenList    : TList;
  139.     procedure TaskClick(Sender : TObject);
  140.     procedure TaskMouseDown(Sender: TObject; Button: TMouseButton;
  141.       Shift: TShiftState; X, Y: Integer);
  142.     procedure WMMouseActivate(var Msg : TWMMouseActivate); message WM_MOUSEACTIVATE;
  143.     procedure ShellWndCreate(var Msg : TMessage); message WM_SHELLWNDCREATE;
  144.     procedure ShellWndDestroy(var Msg : TMessage); message WM_SHELLWNDDESTROY;
  145.     procedure WMMouseHook(var Msg : TMessage); message WM_MOUSEHOOK;
  146.     procedure WMHideQuery(var Msg : TMessage); message WM_HIDEQUERY;
  147.     procedure WMWinActivate(var Msg : TMessage); message WM_WINACTIVE;
  148.     procedure WMAddButton(var Msg : TMessage); message WM_ADDBUTTON;
  149.     procedure AppMessage(var Msg : TMsg; var Handled : Boolean);
  150.     function TaskToButton(task: THandle): Integer;
  151.     function WndToButton(Wnd : HWnd): Integer;
  152.     function ShouldExclude(Wnd : HWND): Boolean;
  153.   public
  154.     { Public declarations }
  155.     procedure Activate;
  156.     procedure Deactivate;
  157.     procedure Press(Wnd: HWND);
  158.     procedure RefreshCaptions;
  159.     procedure RefreshWindows;
  160.     procedure ArrangeButtons;
  161.     procedure UpdateButtons;
  162.     procedure AddButton(Wnd : HWND);
  163.     procedure DeleteButton(Wnd : HWND);
  164.     procedure Configure;
  165.     procedure ActivateHint(p: TPoint);
  166.     procedure CancelHint;
  167.     procedure SetClock(const s : string);
  168.   end;
  169.  
  170. var
  171.   Bar: TBar;
  172.  
  173. implementation
  174.  
  175. uses ShellAPI, ToolHelp, Profile, MiscUtil, Strings;
  176.  
  177. {$R *.DFM}
  178. {$R TASKBMPS.RES}
  179.  
  180. { These headers are used to interface with the included DLL }
  181.  
  182. procedure StartTaskMonitor; far; external 'WNDHOOKS' index 1;
  183. procedure StopTaskMonitor; far; external 'WNDHOOKS' index 2;
  184. procedure SetWndHook; far; external 'WNDHOOKS' index 3;
  185. procedure UnhookWndHook; far; external 'WNDHOOKS' index 4;
  186. procedure SetYLimit(y: Integer); far; external 'WNDHOOKS' index 5;
  187. procedure StartMouseMonitor; far; external 'WNDHOOKS' index 6;
  188. procedure StopMouseMonitor; far; external 'WNDHOOKS' index 7;
  189. procedure EnableMouseMonitor; far; external 'WNDHOOKS' index 8;
  190. procedure DisableMouseMonitor; far; external 'WNDHOOKS' index 9;
  191. procedure SetCallBackWnd(Wnd: HWND); far; external 'WNDHOOKS' index 10;
  192. procedure SetMaxEnabled(value: Boolean); far; external 'WNDHOOKS' index 11;
  193.  
  194. var
  195.   MinAppHeight : Integer;
  196.   YLimit : Integer;
  197.   CheckDisabled : Boolean;
  198.   UseMouseHook  : Boolean;
  199.   Highlight     : Boolean;
  200.   ShrinkMax     : Boolean;
  201.   Clock24       : Boolean;
  202.   PopupRes      : Boolean;
  203.   PopupDate     : Boolean;
  204.   Animate       : Boolean;
  205.   ButtonHints   : Boolean;
  206.   MoveIconsUp   : Boolean;
  207.   ArrangeMin    : Boolean;
  208.   HideMinApps   : Boolean;
  209.   ShowCalWindows: Boolean;
  210.   StartMouseUp  : Boolean;
  211.   CalIcons      : Boolean;
  212.   DocNameFirst  : Boolean;
  213.   DocNameLower  : Boolean;
  214.   ConciseDT     : string[127];
  215.   FullDT        : string[127];
  216.   FullFolderPath: Boolean;
  217.  
  218.  
  219. function GetMinPosition(Wnd: HWND): TPoint;
  220. var place: TWindowPlacement;
  221. begin
  222.   { Returns the position of the window's icon }
  223.   place.Length := sizeof(place);
  224.   GetWindowPlacement(Wnd, @place);
  225.   Result := place.ptMinPosition;
  226. end;
  227.  
  228.  
  229. procedure MoveDesktopIcon(Wnd: HWND; pt: TPoint);
  230. var
  231.   place: TWindowPlacement;
  232. begin
  233.   { Repositions a window's icon.  If the window is minimized,
  234.     it must be hidden before being moved to ensure that the
  235.     desktop background is updated }
  236.  
  237.   place.Length := sizeof(place);
  238.   GetWindowPlacement(Wnd, @place);
  239.  
  240.   with place.ptMinPosition do
  241.     if (x = pt.x) and (y = pt.y) then Exit;
  242.  
  243.   place.ptMinPosition := pt;
  244.   place.Flags := place.Flags or WPF_SETMINPOSITION;
  245.  
  246.   if IsIconic(Wnd) then begin
  247.     ShowWindow(Wnd, SW_HIDE);
  248.     place.ShowCmd := SW_SHOWMINNOACTIVE;
  249.   end
  250.   else
  251.     place.ShowCmd := SW_SHOWNA;
  252.   SetWindowPlacement(Wnd, @place);
  253. end;
  254.  
  255.  
  256. procedure RaiseWindow(Wnd: HWnd);
  257. var p: TPoint;
  258. begin
  259.   { Shifts a minimized window up a little }
  260.   p := GetMinPosition(Wnd);
  261.   if (p.y > YLimit - MinAppHeight) and (p.y < Screen.Height) then begin
  262.     p.y := YLimit - MinAppHeight;
  263.     MoveDesktopIcon(Wnd, p);
  264.   end;
  265. end;
  266.  
  267.  
  268.  
  269.  
  270.  
  271. function TButtonList.GetButtons(i: Integer): TTaskButton;
  272. begin
  273.   Result := TTaskButton(Items[i]);
  274. end;
  275.  
  276.  
  277. procedure GetModuleAndClass(Wnd: HWND; var f, c: OpenString);
  278. begin
  279.   { Fills two strings with the module and class names of a window }
  280.   f[0] := Chr(GetModuleFilename(GetWindowWord(Wnd, GWW_HINSTANCE), @f[1], High(f)-1));
  281.   c[0] := Chr(GetClassName(Wnd, @c[1], High(c)-1));
  282. end;
  283.  
  284.  
  285. function IsTaskWindow(Wnd: HWND): Boolean;
  286. var
  287.   Style: Longint;
  288. begin
  289.   { Returns true if the window qualifies as a "task" }
  290.  
  291.   Style := GetWindowLong(Wnd, GWL_STYLE);
  292.   Result := (GetWindowWord(Wnd, GWW_HWNDPARENT) = 0) and
  293.              Bool(GetWindowTextLength(Wnd)) and
  294.              ((Style and WS_MINIMIZEBOX <> 0) or
  295.              (Style and WS_MAXIMIZEBOX <> 0) or
  296.              (Style and WS_THICKFRAME <> 0))
  297. end;
  298.  
  299.  
  300. function IsVisibleTaskWindow(Wnd: HWND): Boolean;
  301. begin
  302.   Result := IsTaskWindow(Wnd) and IsWindowVisible(Wnd);
  303. end;
  304.  
  305.  
  306. function IsHiddenTaskWindow(Wnd: HWND): Boolean;
  307. begin
  308.   Result := IsTaskWindow(Wnd) and not IsWindowVisible(Wnd);
  309. end;
  310.  
  311.  
  312. function EnumWinProc(Wnd: HWnd; Bar: TBar): Bool; export;
  313. begin
  314.   { Adds all visible task windows to the bar }
  315.   if IsVisibleTaskWindow(Wnd) then begin
  316.     Bar.Perform(WM_SHELLWNDCREATE, Wnd, 0);
  317.     if IsIconic(Wnd) then Bar.Perform(WM_HIDEQUERY, Wnd, 0);
  318.   end;
  319.   Result := True;
  320. end;
  321.  
  322.  
  323.  
  324.  
  325. { TTaskButton }
  326.  
  327. constructor TTaskButton.Create(AOwner : TComponent);
  328. begin
  329.   inherited Create(AOwner);
  330.   Style := sbWin95;
  331.   Margin := 2;
  332.   Spacing := 1;
  333.   GroupIndex := Integer(Highlight);
  334.   AllowAllUp := True;
  335. end;
  336.  
  337.  
  338. procedure TTaskButton.SetWindow(value : HWND);
  339. var
  340.   filename, classname : string[127];
  341. begin
  342.   FWindow := value;
  343.   FTask := GetWindowTask(FWindow);
  344.  
  345.   GetModuleAndClass(Window, filename, classname);
  346.   filename := ExtractFilename(filename);
  347.  
  348.   FWindowType := wtGeneral;
  349.  
  350.   if filename = 'CALMIRA.EXE' then begin
  351.     if classname = 'TIconWindow' then FWindowType := wtIconWindow
  352.     else if classname = 'TExplorer' then FWindowType := wtExplorer
  353.   end;
  354.  
  355.   AssignGlyph;
  356.   RefreshCaption;
  357. end;
  358.  
  359.  
  360. procedure TTaskButton.AssignGlyph;
  361. var
  362.   m, c : string[127];
  363.   h : HIcon;
  364. begin
  365.   if CalmiraWindow > 0 then begin
  366.  
  367.     if ShowCalWindows and (FWindowType <> wtGeneral) then
  368.       case FWindowType of
  369.         wtIconWindow : Glyph.Handle := LoadBitmap(HInstance, 'FOLDERBMP');
  370.         wtExplorer : Glyph.Handle := LoadBitmap(HInstance, 'EXPLOREBMP');
  371.       end
  372.  
  373.     else begin
  374.       { Ask Calmira to provide an icon }
  375.       Application.ProcessMessages;
  376.       h := SendMessage(CalmiraWnd, WM_CALMIRA, CM_GETTASKICON,
  377.         GetWindowWord(Window, GWW_HINSTANCE));
  378.       if h > 1 then begin
  379.         ShrinkIcon(h, Glyph);
  380.         DestroyIcon(h);
  381.       end;
  382.     end;
  383.   end;
  384.  
  385.   if Glyph.Empty then begin
  386.     GetModuleAndClass(Window, m, c);
  387.     h := ExtractIcon(HInstance, StringAsPChar(m), 0);
  388.     ShrinkIcon(h, Glyph);
  389.     DestroyIcon(h);
  390.   end;
  391. end;
  392.  
  393.  
  394. function TTaskButton.MinimizeCaption(s : string): string;
  395.  
  396. var i, j   : Integer;    { counters }
  397.     target : Integer;    { maximum width of text that can fit }
  398.     dw     : Integer;    { width of three dots }
  399.     tw     : Integer;    { current text width }
  400.     app, doc : string[79];
  401. begin
  402.   { Given a string and a button width, truncate it so that it fits
  403.     comfortably on the button.  First check if it fits.  If it doesn't,
  404.     keep chopping the end off until it does and append three dots to it.
  405.  
  406.     To avoid calling Canvas.TextWidth too many times, the string
  407.     is cut in half if the width is over twice the desired width
  408.  
  409.     Bizzare bug: change Bar.Canvas to just Canvas and something very
  410.     strange happens... }
  411.  
  412.   if DocNameFirst then begin
  413.     i := Pos(' - ', s);
  414.     if i > 0 then begin
  415.       app := Copy(s, 1, i-1);
  416.       doc := Copy(s, i+3, 255);
  417.       if DocNameLower then doc := Lowercase(doc);
  418.       s := Format('%s - %s', [doc, app]);
  419.     end;
  420.   end;
  421.  
  422.   tw := Bar.Canvas.TextWidth(s);
  423.  
  424.   if (tw > Width - 22) then begin
  425.     dw := Bar.Canvas.TextWidth('...');
  426.     target := Width - 22 - dw;
  427.  
  428.     if target < dw then begin
  429.       Result := '';
  430.       exit;
  431.     end;
  432.  
  433.     repeat
  434.       if (tw > target * 2) and (s[0] > #1)  then Dec(s[0], ord(s[0]) div 2)
  435.       else Dec(s[0]);
  436.       tw := Bar.Canvas.TextWidth(s);
  437.     until ((tw <= Target) or (Length(s) = 1));
  438.     if Length(s) <= 1 then s := ''
  439.     else AppendStr(s, '...');
  440.   end;
  441.  
  442.   Result := s;
  443. end;
  444.  
  445.  
  446.  
  447. procedure TTaskButton.RefreshCaption;
  448. var
  449.   s: string[127];
  450. begin
  451.   s[0] := Chr(GetWindowText(Window, @s[1], 126));
  452.   Hint := s;
  453.   if (FWindowType = wtIconWindow) and not FullFolderPath and (Length(s) > 3) then
  454.     s := ExtractFilename(s);
  455.   Caption := MinimizeCaption(s);
  456. end;
  457.  
  458.  
  459. { routine for finding a window belonging to a module -- the module handle,
  460.   not instance handle, is given so GetWindowWord can't be used }
  461.  
  462. var FoundWindow : HWND;
  463.  
  464. function WinModuleProc(Wnd: HWnd; Filename: PChar): Bool; export;
  465. var
  466.   m: THandle;
  467.   buf : array[0..127] of char;
  468. begin
  469.   if IsTaskWindow(Wnd) then begin
  470.     GetModuleFilename(GetWindowWord(Wnd, GWW_HINSTANCE), buf, 127);
  471.     if StrComp(Filename, buf) = 0 then begin
  472.       FoundWindow := Wnd;
  473.       Result := False;
  474.       Exit;
  475.     end;
  476.   end;
  477.   FoundWindow := 0;
  478.   Result := True;
  479. end;
  480.  
  481.  
  482. { TTrayProgram }
  483.  
  484. constructor TTrayProgram.Create(AOwner : TComponent);
  485. begin
  486.   inherited Create(AOwner);
  487.   FGlyph := TBitmap.Create;
  488.   SetBounds(0, 0, 20, 20);
  489.   Align := alLeft;
  490. end;
  491.  
  492. destructor TTrayProgram.Destroy;
  493. begin
  494.   FGlyph.Free;
  495.   inherited Destroy;
  496. end;
  497.  
  498. procedure TTrayProgram.Paint;
  499. begin
  500.   Canvas.Draw((Width - FGlyph.Width) div 2, (Height - FGlyph.Height) div 2, FGlyph);
  501. end;
  502.  
  503. procedure TTrayProgram.SetProgram(const filename: TFilename);
  504. var
  505.   h : HIcon;
  506. begin
  507.   FModuleFile := Uppercase(filename);
  508.   h := ExtractIcon(HInstance, StringAsPChar(FModuleFile), 0);
  509.   try
  510.     ShrinkIcon(h, FGlyph);
  511.   finally
  512.     DestroyIcon(h);
  513.   end;
  514. end;
  515.  
  516.  
  517. procedure TTrayProgram.Click;
  518. begin
  519.   if GetModuleHandle(@FModuleFile[1]) > 0 then begin
  520.     { Re-activate the utility }
  521.     EnumWindows(@WinModuleProc, Longint(@FModuleFile[1]));
  522.     if FoundWindow > 0 then
  523.       if IsIconic(FoundWindow) then ShowWindow(FoundWindow, SW_RESTORE)
  524.       else BringWindowToTop(FoundWindow)
  525.   end
  526.   else begin
  527.     { run a new instance and hide the icon }
  528.     WinExec(StringAsPChar(FModuleFile), SW_SHOW);
  529.     EnumWindows(@WinModuleProc, Longint(@FModuleFile[1]));
  530.     if FoundWindow > 0 then MoveDesktopIcon(FoundWindow, Point(0, Screen.Height));
  531.   end;
  532. end;
  533.  
  534.  
  535. { Main taskbar }
  536.  
  537.  
  538. procedure TBar.FormCreate(Sender: TObject);
  539. var
  540.   i: Integer;
  541.   Wnd : HWND;
  542.   buf : TFilename;
  543. begin
  544.   Pressed := -1;
  545.   SetCallBackWnd(Handle);
  546.  
  547.   HintWindow := THintWindow.Create(Application);
  548.   HintWindow.Visible := False;
  549.  
  550.   if Screen.PixelsPerInch > 96 then
  551.     StartBtn.Width := StartBtn.Width + 6;
  552.  
  553.   Screen.Cursor := crHourGlass;
  554.   try
  555.     with Application do begin
  556.       SetWindowLong(Handle, GWL_STYLE,
  557.         GetWindowLong(Handle, GWL_STYLE) and
  558.           not (WS_MAXIMIZEBOX or WS_MINIMIZEBOX));
  559.  
  560.       OnDeactivate := FormDeactivate;
  561.       OnMessage := AppMessage;
  562.     end;
  563.  
  564.     Setbounds(0, Screen.Height -1, Screen.Width, Height);
  565.     ButtonList := TButtonList.Create;
  566.     HiddenList := TList.Create;
  567.  
  568.     Configure;
  569.  
  570.     YLimit := Screen.Height - ClientHeight;
  571.     SetYLimit(YLimit);
  572.  
  573.     StartTaskMonitor;
  574.     if UseMouseHook then StartMouseMonitor;
  575.     SetWndHook;
  576.  
  577.     if Stay.Checked then Activate else Deactivate;
  578.  
  579.     EnumWindows(@EnumWinProc, Longint(self));
  580.   finally
  581.     Screen.Cursor := crDefault;
  582.     DragAcceptFiles(Handle, True);
  583.   end;
  584. end;
  585.  
  586.  
  587. procedure TBar.WMMouseHook(var Msg : TMessage);
  588. begin
  589.   { Called by the DLL when the cursor leaves the taskbar }
  590.   if not (Stay.Checked or MouseCapture) then Deactivate
  591.   else if ButtonHints and HintWindow.Visible then CancelHint;
  592. end;
  593.  
  594.  
  595. procedure TBar.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  596.   Y: Integer);
  597. begin
  598.   if not BarShowing then Activate;
  599.   CancelHint;
  600. end;
  601.  
  602.  
  603. procedure TBar.FormDeactivate(Sender: TObject);
  604. begin
  605.   if not Stay.Checked then Deactivate;
  606. end;
  607.  
  608.  
  609. procedure TBar.Deactivate;
  610. var i : Integer;
  611. begin
  612.   { Suspends the taskbar until it is re-activated by the mouse }
  613.   Timer.Enabled := False;
  614.   BarShowing := False;
  615.   CancelHint;
  616.   Top := Screen.Height - 1;
  617.   if Animate then for i := 0 to ControlCount-1 do Controls[i].Hide;
  618. end;
  619.  
  620.  
  621. function TBar.TaskToButton(task: THandle): Integer;
  622. begin
  623.   { Returns the button index for a given task handle, -1 if the
  624.     task is not shown on the bar }
  625.  
  626.   with ButtonList do
  627.     for Result := 0 to Count-1 do
  628.       if task = Buttons[Result].Task then Exit;
  629.   Result := -1;
  630. end;
  631.  
  632.  
  633. function TBar.WndToButton(Wnd : HWnd): Integer;
  634. begin
  635.   { Returns the button index for a given window handle, -1 if the
  636.   task is not shown on the bar }
  637.  
  638.   with ButtonList do
  639.     for Result := 0 to Count-1 do
  640.       if Wnd = Buttons[Result].Window then Exit;
  641.   Result := -1;
  642. end;
  643.  
  644.  
  645. procedure TBar.Press(Wnd: HWND);
  646. var
  647.   i: Integer;
  648. begin
  649.   { Called when a window receives a WM_ACTIVATE message.  If there is
  650.     a button for that window or the task it belongs to, then that
  651.     button is pressed }
  652.  
  653.   i := WndToButton(Wnd);
  654.   if i = -1 then i := TaskToButton(GetWindowTask(Wnd));
  655.  
  656.   with ButtonList do
  657.     if i > -1 then
  658.       Buttons[i].Down := True
  659.     else if (Pressed > -1) and (Pressed < Count) then
  660.       Buttons[Pressed].Down := False;
  661.  
  662.   Pressed := i;
  663. end;
  664.  
  665.  
  666. procedure TBar.UpdateButtons;
  667. begin
  668.   RefreshWindows;
  669.   ArrangeButtons;
  670.   Press(GetActiveWindow);
  671. end;
  672.  
  673.  
  674. procedure TBar.Activate;
  675. var
  676.   i : Integer;
  677.   Wnd : HWND;
  678. begin
  679.   Timer.Enabled := True;
  680.   SetClock(FormatDateTime(ConciseDT, Now));
  681.   UpdateButtons;
  682.  
  683.   { Move the form up 5 pixels at a time and then show the buttons }
  684.  
  685.   if Animate then begin
  686.     i := Screen.Height - 1;
  687.     while i >= Screen.Height - ClientHeight + 5 do begin
  688.       Top := i;
  689.       Dec(i, 5);
  690.     end;
  691.     Top := Screen.Height - ClientHeight;
  692.   end;
  693.  
  694.   if not StartBtn.Visible then
  695.     for i := 0 to ControlCount-1 do Controls[i].Show;
  696.  
  697.   Top := Screen.Height - ClientHeight;
  698.   BarShowing := True;
  699.   EnableMouseMonitor;
  700. end;
  701.  
  702.  
  703. procedure TBar.FormPaint(Sender: TObject);
  704. begin
  705.   with Canvas do begin
  706.     if BarShowing then begin
  707.       { Paint the 3D effect around the edges }
  708.       Pen.Color := clBtnHighLight;
  709.       MoveTo(0, ClientHeight-1);
  710.       LineTo(0, 1);
  711.       LineTo(ClientWidth-1, 1);
  712.       Pen.Color := clBtnShadow;
  713.       LineTo(ClientWidth-1, ClientHeight-1);
  714.     end;
  715.  
  716.     { Draw a black line across the top }
  717.     Pen.Color := clBlack;
  718.     MoveTo(0, 0);
  719.     LineTo(ClientWidth, 0);
  720.   end;
  721. end;
  722.  
  723.  
  724. procedure TBar.ArrangeButtons;
  725. var i, t, h, w, x, avail: Integer;
  726. begin
  727.   { w is the width of a button plus the gap to its right}
  728.  
  729.   avail := ClientWidth - StartBtn.Width - Clock.Width - 12;
  730.  
  731.   case ButtonList.Count of
  732.     0: Exit;
  733.     1..2: w := avail div 3;
  734.   else
  735.     w := avail div ButtonList.Count;
  736.   end;
  737.  
  738.   { x is initialised to the left side of the first button }
  739.  
  740.   x := StartBtn.Left + StartBtn.Width + 3;
  741.   t := StartBtn.Top;
  742.   h := StartBtn.Height;
  743.  
  744.   with ButtonList do
  745.     for i := 0 to Count-1 do begin
  746.       Buttons[i].SetBounds(x, t, w - 3, h);
  747.       Inc(x, w);
  748.     end;
  749.  
  750.   RefreshCaptions;
  751. end;
  752.  
  753.  
  754.  
  755. procedure TBar.RefreshCaptions;
  756. var
  757.   i: Integer;
  758. begin
  759.   with ButtonList do
  760.     for i := 0 to Count-1 do Buttons[i].RefreshCaption;
  761. end;
  762.  
  763.  
  764. procedure TBar.RefreshWindows;
  765. var
  766.   i: Integer;
  767.   Wnd : HWND;
  768. begin
  769.   { remove any windows that no longer exist or have disappeared }
  770.  
  771.   i := 0;
  772.   with ButtonList do
  773.   for i := Count-1 downto 0 do begin
  774.     Wnd := Buttons[i].Window;
  775.     if not IsWindow(Wnd) or not IsWindowVisible(Wnd)
  776.       or (GetWindowTextLength(Buttons[i].Window) = 0) then begin
  777.       Buttons[i].Free;
  778.       Delete(i);
  779.     end;
  780.   end;
  781. end;
  782.  
  783.  
  784. procedure TBar.AddButton(Wnd : HWND);
  785. var
  786.   button : TTaskButton;
  787. begin
  788.   button := TTaskButton.Create(self);
  789.   ButtonList.Add(button);
  790.  
  791.   with button do begin
  792.     Left := -64;
  793.     Parent := self;
  794.     Window := Wnd;
  795.     OnClick := TaskClick;
  796.     OnMouseDown := TaskMouseDown;
  797.     OnMouseMove := ClockMouseMove;
  798.   end;
  799.  
  800.   if BarShowing then ArrangeButtons;
  801. end;
  802.  
  803.  
  804. procedure TBar.DeleteButton(Wnd : HWND);
  805. var i: Integer;
  806. begin
  807.   { When Wnd is destroyed, look for a button with the matching window
  808.     and remove it, then rearrange the other buttons }
  809.  
  810.   with ButtonList do
  811.   for i := 0 to Count-1 do
  812.     if Buttons[i].Window = Wnd then begin
  813.       Buttons[i].Free;
  814.       Delete(i);
  815.       ArrangeButtons;
  816.       Exit;
  817.     end;
  818. end;
  819.  
  820.  
  821. procedure TBar.TaskClick(Sender : TObject);
  822. var
  823.   wnd : HWND;
  824.   i : Integer;
  825. begin
  826.   { This is the event handler for normal task buttons.
  827.  
  828.     Disabled child windows are skipped in case they cover up the
  829.     active window (e.g. if an icon window covers up a modal dialog,
  830.     there is no way to end the modal state).
  831.  
  832.     The SendMessage trick is required to access full screen DOS boxes
  833.     because of a bug (solution provided by Microsoft) }
  834.  
  835.   Wnd := (Sender as TTaskButton).Window;
  836.  
  837.   if CheckDisabled and not IsWindowEnabled(Wnd)
  838.     and (GetWindowWord(Wnd, GWW_HWNDPARENT) > 0) then begin
  839.     MessageBeep(0);
  840.     Exit;
  841.   end;
  842.  
  843.   InTaskClick := True;
  844.   SendMessage(Wnd, WM_ACTIVATE, WA_ACTIVE, MakeLong(Wnd, Word(True)));
  845.   InTaskClick := False;
  846.  
  847.   if IsIconic(Wnd) then ShowWindow(Wnd, SW_RESTORE)
  848.   else BringWindowToTop(Wnd);
  849. end;
  850.  
  851.  
  852.  
  853. function TBar.ShouldExclude(Wnd : HWND): Boolean;
  854. var
  855.   fname, cname: string[127];
  856. begin
  857.   { Returns True if Wnd should be excluded from the bar }
  858.  
  859.   GetModuleAndClass(Wnd, fname, cname);
  860.   fname := ExtractFilename(fname);
  861.  
  862.   Result := (Excludes.IndexOf(fname) > -1) or
  863.             (Excludes.IndexOf(Format('%s %s', [fname, cname])) > -1);
  864. end;
  865.  
  866.  
  867. procedure TBar.ShellWndCreate(var Msg : TMessage);
  868. begin
  869.   { Called by the shell hook when a top-level window is created }
  870.  
  871.   with msg do
  872.     if not ShouldExclude(wParam) then
  873.       if IsHiddenTaskWindow(wParam) then
  874.         HiddenList.Add(Pointer(wParam))
  875.       else if IsVisibleTaskWindow(wParam) then begin
  876.         AddButton(wParam);
  877.         if IsIconic(wParam) then Perform(WM_HIDEQUERY, wParam, 0);
  878.       end;
  879. end;
  880.  
  881.  
  882. procedure TBar.ShellWndDestroy(var Msg : TMessage);
  883. var i: Integer;
  884. begin
  885.   { Called by the shell hook when a top-level window is created }
  886.   i := HiddenList.IndexOf(Pointer(msg.wParam));
  887.   if i > -1 then HiddenList.Delete(i)
  888.   else DeleteButton(msg.wParam);
  889. end;
  890.  
  891.  
  892. procedure TBar.FormDestroy(Sender: TObject);
  893. var i: Integer;
  894. begin
  895.   StopMouseMonitor;
  896.   StopTaskMonitor;
  897.   UnhookWndHook;
  898.  
  899.   { Apps which have had their icon moved off the screen must be restored
  900.     properly.  If Calmira is active, then its ArrangeIcons function is
  901.     called, but the icons must be moved above Screen.Height so that
  902.     Calmira knows that they are not supposed to be hidden }
  903.  
  904.   if (CalmiraWindow > 0) then begin
  905.     for i := 0 to ButtonList.Count-1 do
  906.       MoveDesktopIcon(ButtonList.Buttons[i].Window,
  907.       Point(0, Screen.Height-1));
  908.     PostMessage(CalmiraWnd, WM_CALMIRA, CM_ARRANGEICONS, 0)
  909.   end
  910.   else
  911.     ArrangeIconicWindows(GetDesktopWindow);
  912.  
  913.   Excludes.Free;
  914.   HiddenList.Free;
  915.   ButtonList.Free;
  916. end;
  917.  
  918.  
  919. procedure TBar.StartBtnClick(Sender: TObject);
  920. var
  921.   p: TPoint;
  922. begin
  923.   DisableMouseMonitor;
  924.   p := Point(0, Top);
  925.   PostMessage(CalmiraWindow, WM_CALMIRA, CM_STARTMENU, Longint(p))
  926. end;
  927.  
  928.  
  929. procedure TBar.FormMouseDown(Sender: TObject; Button: TMouseButton;
  930.   Shift: TShiftState; X, Y: Integer);
  931. var
  932.   control : TControl;
  933.   i : Integer;
  934. begin
  935.   { "Terminate" mode distinguished by the cursor being crNoDrop }
  936.  
  937.   if Cursor = crNoDrop then begin
  938.  
  939.     if Button = mbLeft then begin
  940.       control := ControlAtPos(Point(X, Y), True);
  941.       if control is TTaskButton then
  942.         TerminateApp(TTaskButton(control).Task, NO_UAE_BOX);
  943.     end;
  944.  
  945.     for i := 0 to ControlCount-1 do Controls[i].Enabled := True;
  946.     Cursor := crDefault;
  947.   end;
  948. end;
  949.  
  950.  
  951. procedure TBar.TaskMouseDown(Sender: TObject; Button: TMouseButton;
  952.   Shift: TShiftState; X, Y: Integer);
  953. var p: TPoint;
  954. begin
  955.   { To remember which button the right mouse button was pressed over,
  956.     tha Tag is used rather than using the PopupComponent property --
  957.     just in case the button gets deleted before the menu click occurs }
  958.  
  959.   if Button = mbLeft then exit;
  960.   TaskMenu.Tag := (Sender as TTaskButton).Window;
  961.   DisableMouseMonitor;
  962.   GetCursorPos(p);
  963.   TaskMenu.Popup(p.X, p.Y);
  964.   EnableMouseMonitor;
  965. end;
  966.  
  967. procedure TBar.RestoreClick(Sender: TObject);
  968. begin
  969.   ShowWindow(TaskMenu.Tag, SW_RESTORE);
  970. end;
  971.  
  972. procedure TBar.MinimizeClick(Sender: TObject);
  973. begin
  974.   CloseWindow(TaskMenu.Tag);
  975. end;
  976.  
  977. procedure TBar.MaximizeClick(Sender: TObject);
  978. begin
  979.   ShowWindow(TaskMenu.Tag, SW_SHOWMAXIMIZED);
  980. end;
  981.  
  982. procedure TBar.CloseItemClick(Sender: TObject);
  983. begin
  984.   PostMessage(TaskMenu.Tag, WM_CLOSE, 0, 0);
  985. end;
  986.  
  987.  
  988. procedure TBar.TaskMenuPopup(Sender: TObject);
  989. var
  990.   Wnd : HWND;
  991.   Zoomed, Iconic: Boolean;
  992.   Style : Longint;
  993. begin
  994.   with TaskMenu do begin
  995.     Wnd := Tag;
  996.     Zoomed := IsZoomed(Wnd);
  997.     Iconic := IsIconic(Wnd);
  998.     Style := GetWindowLong(Wnd, GWL_STYLE);
  999.  
  1000.     Restore.Enabled := Zoomed or Iconic;
  1001.     Minimize.Enabled := not Iconic and (Style and WS_MINIMIZEBOX <> 0);
  1002.     Maximize.Enabled := not Zoomed and (Style and WS_MAXIMIZEBOX <> 0);
  1003.     CloseItem.Enabled := IsWindowEnabled(Wnd);
  1004.   end;
  1005. end;
  1006.  
  1007.  
  1008.  
  1009. procedure TBar.TerminateClick(Sender: TObject);
  1010. var i: Integer;
  1011. begin
  1012.   { Start terminate mode by disabling buttons and setting crNoDrop cursor }
  1013.  
  1014.   StartBtn.Enabled := False;
  1015.   with ButtonList do
  1016.   for i := 0 to Count-1 do begin
  1017.     Buttons[i].Down := False;
  1018.     Buttons[i].Enabled := False;
  1019.   end;
  1020.   Cursor := crNoDrop;
  1021.   Pressed := -1;
  1022. end;
  1023.  
  1024.  
  1025. procedure TBar.StartBtnMouseDown(Sender: TObject; Button: TMouseButton;
  1026.   Shift: TShiftState; X, Y: Integer);
  1027. var p: TPoint;
  1028. begin
  1029.   if Button = mbRight then begin
  1030.     DisableMouseMonitor;
  1031.     GetCursorPos(p);
  1032.     SysMenu.Popup(p.X, p.Y);
  1033.     EnableMouseMonitor;
  1034.   end
  1035.   else if not StartMouseUp then begin
  1036.     { Restore start button state by simulating a mouse click }
  1037.     StartBtnClick(self);
  1038.     PostMessage(Handle, WM_LBUTTONUP, 0,
  1039.       MakeLong(StartBtn.Left + 3, StartBtn.Top + 3));
  1040.   end;
  1041. end;
  1042.  
  1043.  
  1044. procedure TBar.QuitClick(Sender: TObject);
  1045. begin
  1046.   Close;
  1047. end;
  1048.  
  1049.  
  1050. procedure TBar.SysMenuPopup(Sender: TObject);
  1051. begin
  1052.   Terminate.Enabled := ControlCount > 3;
  1053. end;
  1054.  
  1055.  
  1056. procedure TBar.FormResize(Sender: TObject);
  1057. begin
  1058.   Clock.Left := ClientWidth - 4 - Clock.Width;
  1059. end;
  1060.  
  1061.  
  1062. procedure TBar.TimerTimer(Sender: TObject);
  1063. begin
  1064.   SetClock(FormatDateTime(ConciseDT, Now));
  1065.   if BarShowing then UpdateButtons;
  1066. end;
  1067.  
  1068.  
  1069.  
  1070. procedure TBar.ClockMouseDown(Sender: TObject; Button: TMouseButton;
  1071.   Shift: TShiftState; X, Y: Integer);
  1072. begin
  1073.   SetClock(IntToStr(GetFreeSpace(0) div 1024) + ' KB');
  1074. end;
  1075.  
  1076.  
  1077. procedure TBar.ClockMouseUp(Sender: TObject; Button: TMouseButton;
  1078.   Shift: TShiftState; X, Y: Integer);
  1079. begin
  1080.   SetClock(FormatDateTime(ConciseDT, Now));
  1081. end;
  1082.  
  1083. procedure TBar.ClockMouseMove(Sender: TObject; Shift: TShiftState; X,
  1084.   Y: Integer);
  1085. begin
  1086.   if ((Sender <> Clock) and not ButtonHints) or (HintControl = Sender) then Exit;
  1087.  
  1088.   HintControl := Sender as TControl;
  1089.  
  1090.   if Hintwindow.Visible then
  1091.     ActivateHint(HintControl.ClientToScreen(Point(X, Y)))
  1092.   else
  1093.     HintTimer.Enabled := True;
  1094. end;
  1095.  
  1096.  
  1097. procedure ShowMinimized(Wnd : HWND);
  1098. begin
  1099.   if not IsIconic(Wnd) and
  1100.     (GetWindowLong(Wnd, GWL_STYLE) and WS_MINIMIZEBOX <> 0) then
  1101.     ShowWindow(Wnd, SW_SHOWMINIMIZED);
  1102. end;
  1103.  
  1104. procedure TBar.AppMessage(var Msg : TMsg; var Handled : Boolean);
  1105. var
  1106.   p: TPoint;
  1107.   control : TControl;
  1108.   i : Integer;
  1109.   Wnd : HWND;
  1110. begin
  1111.   { Application.OnMessage handler. }
  1112.  
  1113.   if (Msg.Message = WM_SYSCOMMAND) and (Msg.wParam = SC_SCREENSAVE) then
  1114.     Deactivate
  1115.  
  1116.   else if Msg.Message = WM_DROPFILES then begin
  1117.     { Find the target window and check that it accepts files before
  1118.       forwarding the message on }
  1119.     DragQueryPoint(Msg.wParam, p);
  1120.     control := ControlAtPos(p, False);
  1121.     if control <> nil then begin
  1122.       i := ButtonList.IndexOf(control);
  1123.       if (i > -1) and (ButtonList.Buttons[i].WindowType = wtGeneral) then begin
  1124.         Wnd := ButtonList.Buttons[i].Window;
  1125.         if GetWindowLong(Wnd, GWL_EXSTYLE) and WS_EX_ACCEPTFILES <> 0 then begin
  1126.           PostMessage(Wnd, WM_DROPFILES, Msg.wParam, Msg.lParam);
  1127.           Exit;
  1128.         end;
  1129.       end;
  1130.     end;
  1131.     { release files after an error }
  1132.     DragFinish(Msg.wParam);
  1133.     MessageBeep(0);
  1134.   end
  1135.  
  1136.   else if Msg.Message = WM_CALMIRA then begin
  1137.     Handled := True;
  1138.     case Msg.wParam of
  1139.       CM_TASKCONFIG    : Configure;
  1140.       CM_STARTCLOSE    : begin
  1141.                            StartBtn.Down := False;
  1142.                            EnableMouseMonitor;
  1143.                          end;
  1144.       CM_UNLOADTASKBAR : Application.Terminate;
  1145.       CM_ADDCALWINDOW  : if ShowCalWindows then AddButton(Msg.lParam);
  1146.       CM_DELCALWINDOW  : DeleteButton(Msg.lParam);
  1147.       CM_MINIMIZEALL   : with ButtonList do
  1148.                            for i := 0 to Count-1 do
  1149.                              ShowMinimized(Buttons[i].Window);
  1150.  
  1151.     end;
  1152.   end
  1153.  
  1154.   else if HintWindow.IsHintMsg(Msg) then CancelHint
  1155. end;
  1156.  
  1157.  
  1158. procedure TBar.Configure;
  1159. var
  1160.   ini : TProfile;
  1161.   i : Integer;
  1162.   TrayApps : TStringList;
  1163.   tp : TTrayProgram;
  1164. begin
  1165.   { reads settings and adjusts controls to reflect the changes }
  1166.  
  1167.   Excludes.Free;
  1168.   Excludes := TStringList.Create;
  1169.  
  1170.   ini := TProfile.Create(ApplicationPath + 'CALMIRA.INI');
  1171.  
  1172.   with ini do begin
  1173.     ReadStrings('Exclude', Excludes);
  1174.     Timer.Interval     := ReadInteger('Taskbar', 'Refresh', 5) * 1000;
  1175.     MinAppHeight       := ReadInteger('Taskbar', 'MinAppHeight', 60);
  1176.     HintTimer.Interval := ReadInteger('Taskbar', 'HintDelay', 800);
  1177.     UseMouseHook       := ReadBool('Taskbar', 'UseMouseHook', True);
  1178.     CheckDisabled      := ReadBool('Taskbar', 'CheckDisabled', True);
  1179.     Stay.Checked       := ReadBool('Taskbar', 'StayVisible', False);
  1180.     Highlight          := ReadBool('Taskbar', 'Highlight', True);
  1181.     ShrinkMax          := ReadBool('Taskbar', 'ShrinkMax', True);
  1182.     Clock24            := ReadBool('Taskbar', 'Clock24', True);
  1183.     PopupRes           := ReadBool('Taskbar', 'PopupRes', True);
  1184.     PopupDate          := ReadBool('Taskbar', 'PopupDate', True);
  1185.     Animate            := ReadBool('Taskbar', 'Animate', True);
  1186.     ButtonHints        := ReadBool('Taskbar', 'ButtonHints', True);
  1187.     ArrangeMin         := ReadBool('Taskbar', 'ArrangeMin', True);
  1188.     HideMinApps        := ReadBool('Taskbar', 'MideMinApps', True);
  1189.     ShowCalWindows     := ReadBool('Taskbar', 'ShowCalWindows', True);
  1190.     CalIcons           := ReadBool('Taskbar', 'CalIcons', True);
  1191.     DocNameFirst       := ReadBool('Taskbar', 'DocNameFirst', False);
  1192.     DocNameLower       := ReadBool('Taskbar', 'DocNameLower', False);
  1193.     StartMouseUp       := ReadBool('Start Menu', 'StartMouseUp', True);
  1194.     FullFolderPath     := ReadBool('Taskbar', 'FullFolderPath', False);
  1195.  
  1196.     if Clock24 then
  1197.       ConciseDT := ReadString('Taskbar', '24HourFormat', 'h:mm')
  1198.     else
  1199.       ConciseDT := ReadString('Taskbar', '12HourFormat', 'h:mm AM/PM');
  1200.  
  1201.     FullDT := ReadString('Taskbar', 'FullDateTime', 'dddd, mmmm d, yyyy');
  1202.     StringToColor(ReadString('Colors', 'Taskbar', 'clSilver'));
  1203.     StartBtn.Caption := ReadString('Start button', 'Caption', 'Start');
  1204.     ReadFont('Taskbar', Font);
  1205.     ReadFont('Start button', StartBtn.Font);
  1206.   end;
  1207.  
  1208.   if not StartMouseUp then StartBtn.OnClick := nil
  1209.   else StartBtn.OnClick := StartBtnClick;
  1210.  
  1211.   SetMaxEnabled(Stay.Checked and ShrinkMax);
  1212.  
  1213.  
  1214.   { Clear Calmira buttons if they have been turned off, and also
  1215.     adjust button states }
  1216.  
  1217.   with ButtonList do
  1218.     for i := Count-1 downto 0 do with Buttons[i] do
  1219.       if not ShowCalWindows and (WindowType <> wtGeneral) then begin
  1220.         Free;
  1221.         ButtonList.Delete(i)
  1222.       end else begin
  1223.         GroupIndex := Integer(Highlight);
  1224.         Down := False;
  1225.       end;
  1226.  
  1227.   { Clear the system tray }
  1228.  
  1229.   with Clock do begin
  1230.     i := ControlCount * 20;
  1231.     Left := Left + i;
  1232.     Width := Width - i;
  1233.     while ControlCount > 0 do Controls[0].Free;
  1234.   end;
  1235.   Clock.Alignment := taCenter;
  1236.  
  1237.   TrayApps := TStringList.Create;
  1238.   ini.ReadStrings('System Tray', TrayApps);
  1239.  
  1240.   { Load system tray programs }
  1241.  
  1242.   if TrayApps.Count > 0 then begin
  1243.     Clock.Alignment := taRightJustify;
  1244.     for i := 0 to TrayApps.Count-1 do begin
  1245.       Clock.Left := Clock.Left - 20;
  1246.       Clock.Width := Clock.Width + 20;
  1247.       tp := TTrayProgram.Create(self);
  1248.       tp.SetProgram(TrayApps[i]);
  1249.       tp.Parent := Clock;
  1250.       Excludes.Add(ExtractFilename(TrayApps[i]));
  1251.     end;
  1252.   end;
  1253.  
  1254.   TrayApps.Free;
  1255.  
  1256.   ini.Free;
  1257.   TimerTimer(self);
  1258. end;
  1259.  
  1260.  
  1261. procedure TBar.StayClick(Sender: TObject);
  1262. begin
  1263.   Stay.Checked := not Stay.Checked;
  1264.   SetMaxEnabled(Stay.Checked and ShrinkMax);
  1265. end;
  1266.  
  1267.  
  1268. procedure TBar.HideBarClick(Sender: TObject);
  1269. begin
  1270.   Deactivate;
  1271. end;
  1272.  
  1273.  
  1274. procedure TBar.CancelHint;
  1275. begin
  1276.   with HintWindow do begin
  1277.     Visible := False;
  1278.     if HandleAllocated then ShowWindow(Handle, SW_HIDE);
  1279.   end;
  1280.   HintControl := nil;
  1281. end;
  1282.  
  1283.  
  1284. procedure TBar.ActivateHint(P: TPoint);
  1285. var
  1286.   HintStr: string;
  1287.   fname, cname: string[127];
  1288.   r : TRect;
  1289.  
  1290. procedure AddField(const s: string);
  1291. begin
  1292.   if HintStr > '' then AppendStr(HintStr, '  ');
  1293.   AppendStr(Hintstr, s);
  1294. end;
  1295.  
  1296. begin
  1297.   if HintControl = nil then Exit;
  1298.   if HintWindow.HandleAllocated then ShowWindow(HintWindow.Handle, SW_HIDE);
  1299.  
  1300.     if HintControl = Clock then begin
  1301.       HintStr := '';
  1302.       if PopupDate then AddField(FormatDateTime(FullDT, Now));
  1303.       if PopupRes then AddField(
  1304.         Format('sys %d%%  gdi %d%%  user %d%%',
  1305.         [GetFreeSystemResources(GFSR_SYSTEMRESOURCES),
  1306.          GetFreeSystemResources(GFSR_GDIRESOURCES),
  1307.          GetFreeSystemResources(GFSR_USERRESOURCES)]));
  1308.     end
  1309.     else if HintControl is TTaskButton then begin
  1310.       HintStr := HintControl.Hint;
  1311.       if Spy.Checked then begin
  1312.         GetModuleAndClass(TTaskButton(HintControl).Window, fname, cname);
  1313.         AppendStr(HintStr, Format('   %s(%s)', [ExtractFilename(fname), cname]));
  1314.       end;
  1315.     end;
  1316.  
  1317.   r.Left := HintControl.Left;
  1318.   r.Right := r.Left + HintWindow.Canvas.TextWidth(HintStr) + 6;
  1319.   r.Bottom := Top - 2;
  1320.   r.Top := r.Bottom - Abs(HintWindow.Canvas.Font.Height) - 4;
  1321.   HintWindow.ActivateHint(r, HintStr);
  1322.   HintWindow.Visible := True;
  1323. end;
  1324.  
  1325.  
  1326. procedure TBar.HintTimerTimer(Sender: TObject);
  1327. var
  1328.   P: TPoint;
  1329.   Control: TControl;
  1330. begin
  1331.   GetCursorPos(P);
  1332.   Control := FindDragTarget(P, True);
  1333.   if Control = HintControl then ActivateHint(P);
  1334.   HintTimer.Enabled := False;
  1335. end;
  1336.  
  1337.  
  1338. procedure TBar.SpyClick(Sender: TObject);
  1339. begin
  1340.   with Spy do Checked := not Checked;
  1341. end;
  1342.  
  1343.  
  1344. procedure TBar.WMHideQuery(var Msg : TMessage);
  1345. var
  1346.   i: Integer;
  1347. begin
  1348.   if HideMinApps then begin
  1349.     i := WndToButton(Msg.wParam);
  1350.     if i > -1 then begin
  1351.       MoveDesktopIcon(Msg.wParam, Point(0, Screen.Height));
  1352.       Exit;
  1353.     end;
  1354.   end;
  1355.  
  1356.   if ArrangeMin then RaiseWindow(Msg.wParam);
  1357. end;
  1358.  
  1359.  
  1360. procedure TBar.WMWinActivate(var Msg : TMessage);
  1361. var i: Integer;
  1362. begin
  1363.   if not InTaskClick then begin
  1364.     i := HiddenList.IndexOf(Pointer(Msg.wParam));
  1365.     if (i > -1) and IsVisibleTaskWindow(Msg.wParam) then begin
  1366.       if not ShouldExclude(msg.wParam) then
  1367.         PostMessage(Handle, WM_ADDBUTTON, Word(HiddenList[i]), 0);
  1368.       HiddenList.Delete(i);
  1369.     end
  1370.     else Press(Msg.WParam);
  1371.   end;
  1372. end;
  1373.  
  1374.  
  1375. procedure TBar.WMMouseActivate(var Msg : TWMMouseActivate);
  1376. begin
  1377.   Msg.Result := MA_NOACTIVATE;
  1378. end;
  1379.  
  1380.  
  1381. procedure TBar.WMAddButton(var Msg : TMessage);
  1382. begin
  1383.   AddButton(Msg.wParam);
  1384.   Press(Msg.wParam);
  1385. end;
  1386.  
  1387.  
  1388. procedure TBar.Startproperties1Click(Sender: TObject);
  1389. begin
  1390.   PostMessage(CalmiraWindow, WM_CALMIRA, CM_STARTPROP, 0);
  1391. end;
  1392.  
  1393.  
  1394. procedure TBar.Properties1Click(Sender: TObject);
  1395. begin
  1396.   PostMessage(CalmiraWindow, WM_CALMIRA, CM_TASKPROP, 0);
  1397. end;
  1398.  
  1399. procedure TBar.SetClock(const s : string);
  1400. begin
  1401.   if Clock.ControlCount > 0 then Clock.Caption := s + '  '
  1402.   else Clock.Caption := s;
  1403. end;
  1404.  
  1405.  
  1406. initialization
  1407. end.
  1408.