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