home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d56 / RMCTL.ZIP / rmTaskBar.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-22  |  32KB  |  1,177 lines
  1. {================================================================================
  2. Copyright (C) 1997-2001 Mills Enterprise
  3.  
  4. Unit     : rmTaskBar
  5. Purpose  : To allow window control from a central location.  Also has support
  6.            in it to fix the M$ MDI window bugs.
  7. Date     : 12-01-1998
  8. Author   : Ryan J. Mills
  9. Version  : 1.80
  10. ================================================================================}
  11.  
  12. unit rmTaskBar;
  13.  
  14. interface
  15.  
  16. {$I CompilerDefines.INC}
  17.  
  18. uses
  19.   Windows, Messages, Classes, Graphics, Controls, Forms, extctrls, menus;
  20.  
  21. type
  22.   TUpdateWindowListEvent = procedure(Sender: TObject; Form: TForm; var AddToList: boolean) of object;
  23.   TUpdatedWindowListEvent = procedure(Sender: TObject; Form: TForm) of object;
  24. {$IFDEF rmDebug}
  25.   TrmTestEvent = procedure(index: integer; msg: integer) of object;
  26. {$ENDIF}
  27.   TWinType = (wtMDIChild, wtDialog, wtToolWin);
  28.   TWinTypes = set of TWinType;
  29.  
  30.   TrmTaskBar = class(TCustomControl)
  31.   private
  32.     { Private declarations }
  33.     OldWndProc: TFarProc;
  34.     NewWndProc: Pointer;
  35.  
  36.     OldMDIWndProc: TFarProc;
  37.     NewMDIWndProc: Pointer;
  38.  
  39.     OldApplicationWndProc: TFarProc;
  40.     NewApplicationWndProc: Pointer;
  41.  
  42.     FHint: string;
  43.     FTimer: TTimer;
  44.     fDelay: integer;
  45.     FColor: TColor;
  46.     fBufferBMP: TBitmap;
  47.     FIconBMP: TBitmap;
  48.     FLabelBMP: TBitmap;
  49.     FWindowList: TList;
  50.     FTempList: TList;
  51.     fmenuWin: TForm;
  52.     fAutoHide: boolean;
  53.     fAutoMinimize: boolean;
  54.     fLastActiveForm: TForm;
  55.     fLastActiveMDIChild: TForm;
  56.     fExcludeWinTypes: TWinTypes;
  57.     fMinBtnSize: integer;
  58.     fBtnSpace: integer;
  59.     fMaxBtnSize: integer;
  60.     fBtnHeight: integer;
  61.     fLeftMargin: integer;
  62.     fRightMargin: integer;
  63.     FTaskHint: THintWindow;
  64.     fButtons: array of TRect;
  65.     fOnAddingWindow: TUpdateWindowListEvent;
  66.     fOnWindowAdded: TUpdatedWindowListEvent;
  67.     fOnWindowRemoved: TUpdatedWindowListEvent;
  68. {$IFDEF rmDebug}
  69.     fWinMessage: TrmTestEvent;
  70. {$ENDIF}
  71.     fMDIMenuRefresh: TNotifyEvent;
  72.     fTopMargin: integer;
  73.     fMainFormFocused: boolean;
  74.     fFlat: boolean;
  75.  
  76.     procedure SetColor(const Value: TColor);
  77.     procedure wmCommand(var msg: TMessage); message wm_command;
  78.     procedure wmEraseBkgnd(var msg: TMessage); message WM_ERASEBKGND;
  79.     procedure wmDestroy(var msg: TMessage); message wm_destroy;
  80.     procedure SetAutoHide(const Value: boolean);
  81.     procedure SetExcludes(const Value: TWinTypes);
  82.     procedure SetBtnHeight(const Value: integer);
  83.     procedure SetBtnSpace(const Value: integer);
  84.     procedure SetMaxBtnSize(const Value: integer);
  85.     procedure SetMinBtnSize(const Value: integer);
  86.     procedure SetLeftMargin(const Value: integer);
  87.     procedure SetRightMargin(const Value: integer);
  88.     procedure SetTopMargin(const Value: integer);
  89.     procedure CMMouseLeave(var msg: TMessage); message cm_MouseLeave;
  90.  
  91.     procedure HookWin;
  92.     procedure UnhookWin;
  93.  
  94.     procedure HookMDIWin;
  95.     procedure UnhookMDIWin;
  96.  
  97.     function GetActiveForm: TForm;
  98.     function GetWindowCount: integer;
  99.     function GetWindowItem(index: integer): TForm;
  100.     function GetMDIChild(index: integer): TForm;
  101.     function GetMDIChildCount: integer;
  102.     function GetActiveMDIChild: TForm;
  103.     procedure SetFlat(const Value: boolean);
  104.   protected
  105.     { Protected declarations }
  106.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  107.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  108.     procedure UnRegisterWindow(F: TForm);
  109.     procedure RegisterWindow(F: TForm);
  110.     procedure RegisterWindowTemp(F: TForm);
  111.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  112.     procedure DoTimer(Sender: TObject);
  113.     procedure SetDelay(const Value: integer);
  114.     procedure MinimizeWindowTypes(WinTypes: TWinTypes);
  115.  
  116.     procedure HookWndProc(var AMsg: TMessage);
  117.     procedure HookMDIWndProc(var AMsg: TMessage);
  118.  
  119.     procedure DoDummyForm(ToggleForm: TForm);
  120.   public
  121.     { Public declarations }
  122.     constructor Create(AOwner: TComponent); override;
  123.     destructor Destroy; override;
  124.     procedure Paint; override;
  125.     procedure HideHint(ClearHint: Boolean);
  126.     procedure MinimizeAllMDI;
  127.     procedure MinimizeAll;
  128.     property ActiveMDIChild: TForm read GetActiveMDIChild;
  129.     property MDIChildren[index: integer]: TForm read GetMDIChild;
  130.     property MDIChildCount: integer read GetMDIChildCount;
  131.     property WindowCount: integer read GetWindowCount;
  132.     property ActiveWindow: TForm read GetActiveForm;
  133.     property WindowList[index: integer]: TForm read GetWindowItem;
  134. {$IFDEF rmDebug}
  135.     property OnWinMessage: TrmTestEvent read fWinMessage write fWinMessage;
  136. {$ENDIF}
  137.   published
  138.     { Published declarations }
  139.     property LeftMargin: integer read fLeftMargin write SetLeftMargin default 3;
  140.     property RightMargin: integer read fRightMargin write SetRightMargin default 3;
  141.     property TopMargin: integer read fTopMargin write SetTopMargin default 3;
  142.     property BtnSpace: integer read fBtnSpace write SetBtnSpace default 3;
  143.     property MaxBtnSize: integer read fMaxBtnSize write SetMaxBtnSize default 150;
  144.     property MinBtnsize: integer read fMinBtnSize write SetMinBtnSize default 5;
  145.     property BtnHeight: integer read fBtnHeight write SetBtnHeight default 23;
  146.     property ParentFont;
  147.     property Font;
  148.     property HintDelay: integer read fDelay write SetDelay default 2500;
  149.     property ExcludeWindowTypes: TWinTypes read fExcludeWinTypes write SetExcludes;
  150.     property Color: TColor read FColor write SetColor default clbtnface;
  151.     property Flat : boolean read fFlat write SetFlat default false;
  152.     property AutoHideMDIChildren: boolean read fAutoHide write SetAutoHide default false;
  153.     property AutoMinimize: boolean read fAutoMinimize write fAutoMinimize default false;
  154.     property OnAddingWindow: TUpdateWindowListEvent read fOnAddingWindow write fOnAddingWindow;
  155.     property OnWindowAdded: TUpdatedWindowListEvent read fOnWindowAdded write fOnWindowAdded;
  156.     property OnWindowRemoved: TUpdatedWindowListEvent read fOnWindowRemoved write fOnWindowRemoved;
  157.     property OnMDIMenuRefresh: TNotifyEvent read fMDIMenuRefresh write fMDIMenuRefresh;
  158.   end;
  159.  
  160. implementation
  161.  
  162. { TrmTaskBar }
  163.  
  164. constructor TrmTaskBar.Create(AOwner: TComponent);
  165. begin
  166.   inherited create(AOwner);
  167.  
  168.   ControlStyle := ControlStyle + [csAcceptsControls, csOpaque];
  169.  
  170.   NewWndProc := nil;
  171.   OldWndProc := nil;
  172.  
  173.   NewMDIWndProc := nil;
  174.   OldMDIWndProc := nil;
  175.  
  176.   OldApplicationWndProc := nil;
  177.   NewApplicationWndProc := nil;
  178.  
  179.   align := alBottom;
  180.   height := 28;
  181.   fColor := clBtnFace;
  182.   fAutoHide := false;
  183.   fAutoMinimize := false;
  184.   fBufferBMP := tbitmap.create;
  185.   FIconBMP := TBitmap.create;
  186.   FLabelBMP := TBitmap.create;
  187.   FWindowList := TList.create;
  188.   FTempList := TList.create;
  189.   fLastActiveForm := nil;
  190.   fLastActiveMDIChild := nil;
  191.   fExcludeWinTypes := [];
  192.   LeftMargin := 3;
  193.   RightMargin := 3;
  194.   TopMargin := 3;
  195.   BtnSpace := 3;
  196.   MaxBtnSize := 150;
  197.   MinBtnsize := 5;
  198.   BtnHeight := 23;
  199.   fFlat := false;
  200.  
  201.   SetLength(fButtons, 0);
  202.   fdelay := 2500;
  203.  
  204.   FTaskHint := THintWindow.create(self);
  205.   FTaskHint.Color := clInfobk;
  206.   FTaskHint.Canvas.Font.color := clInfoText;
  207.   FTaskHint.Canvas.Pen.Color := clWindowFrame;
  208.  
  209.   FTimer := TTimer.Create(self);
  210.   FTimer.OnTimer := DoTimer;
  211.  
  212.   fMainFormFocused := false;
  213.  
  214.   HookWin;
  215. end;
  216.  
  217. destructor TrmTaskBar.Destroy;
  218. begin
  219.   SetLength(fButtons, 0);
  220.   fBufferBMP.free;
  221.   FIconBMP.free;
  222.   FLabelBMP.free;
  223.   FWindowList.free;
  224.   FTempList.free;
  225.   FTaskHint.free;
  226.   FTimer.free;
  227.   UnHookWin;
  228.   inherited;
  229. end;
  230.  
  231. procedure TrmTaskBar.CMMouseLeave(var msg: TMessage);
  232. begin
  233.   inherited;
  234.   HideHint(True);
  235.   if Flat then
  236.      Invalidate;
  237. end;
  238.  
  239. procedure TrmTaskBar.DoTimer(Sender: TObject);
  240. begin
  241.   FTimer.Enabled := false;
  242.   HideHint(false);
  243. end;
  244.  
  245. procedure TrmTaskBar.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  246.   Y: Integer);
  247. var
  248.   loop, btncount: integer;
  249.   found: boolean;
  250.   f: tform;
  251.   tempmenuhandle: HMENU;
  252.   newpoint: tpoint;
  253. begin
  254.   fmenuwin := nil;
  255.   btncount := high(fButtons);
  256.   loop := 0;
  257.   newpoint := point(x, y);
  258.   found := false;
  259.  
  260.   while loop <= btncount do
  261.   begin
  262.     if ptinrect(fbuttons[loop], newpoint) then
  263.     begin
  264.       found := true;
  265.       break;
  266.     end;
  267.     inc(loop);
  268.   end;
  269.  
  270.   if (found) and (loop < fWindowList.count) then
  271.   begin
  272.     f := TForm(FWindowList[loop]);
  273.     try
  274.       if assigned(f) and isWindow(f.handle) then
  275.       begin
  276.         if (button = mbleft) then
  277.         begin
  278.           if (screen.ActiveForm <> application.mainform) then
  279.           begin
  280.             if (screen.ActiveForm = f) and (fLastActiveForm = f) and (f.WindowState <> wsminimized) then
  281.             begin
  282.               if fautominimize then
  283.                 f.WindowState := wsminimized;
  284.             end
  285.             else
  286.             begin
  287.               if f.windowstate = wsminimized then
  288.                 f.windowstate := wsNormal;
  289.               f.bringtofront;
  290.               f.setfocus;
  291.               if fMainFormFocused then
  292.               begin
  293.                  fMainFormFocused := false;
  294.                  invalidate;
  295.               end;
  296.             end;
  297.           end
  298.           else if (screen.activeform = application.mainform) and (fLastActiveMDIChild = f) then
  299.           begin
  300.             DoDummyForm(f);
  301.           end
  302.           else
  303.           begin
  304.             if (fLastActiveForm = f) and (f.WindowState <> wsminimized) then
  305.             begin
  306.               if fautominimize then
  307.                 f.WindowState := wsminimized;
  308.             end
  309.             else
  310.             begin
  311.  
  312.               if f.windowstate = wsminimized then
  313.                 f.windowstate := wsNormal;
  314.  
  315.               f.bringtofront;
  316.  
  317.               if assigned(f.activecontrol) then
  318.                 f.activecontrol.SetFocus
  319.               else
  320.               begin
  321.                 for loop := 0 to f.ControlCount - 1 do
  322.                 begin
  323.                   if f.Controls[loop] is TWincontrol then
  324.                   begin
  325.                     tWinControl(f.Controls[loop]).setfocus;
  326.                     break;
  327.                   end;
  328.                 end;
  329.               end;
  330.             end;
  331.           end;
  332.         end;
  333.         if (button = mbright) then
  334.         begin
  335.           newpoint := clienttoscreen(newpoint);
  336.           fmenuWin := f;
  337.           tempmenuhandle := Getsystemmenu(f.handle, false);
  338.           TrackPopupMenu(tempmenuhandle, tpm_leftalign or TPM_LEFTBUTTON, newpoint.x - 1, newpoint.y - 2, 0, self.handle, nil);
  339.         end;
  340.       end;
  341.     except
  342.       UnRegisterWindow(f);
  343.     end;
  344.   end;
  345. end;
  346.  
  347. procedure TrmTaskBar.MouseMove(Shift: TShiftState; X, Y: Integer);
  348. var
  349.   tw, th, loop, btncount: integer;
  350.   found: boolean;
  351.   f: tform;
  352.   newpoint: tpoint;
  353.   wrect: TRect;
  354.   oldHint: string;
  355. begin
  356.   fmenuwin := nil;
  357.   btncount := high(fButtons);
  358.   loop := 0;
  359.   newpoint := point(x, y);
  360.   found := false;
  361.  
  362.   while loop <= btncount do
  363.   begin
  364.     if ptinrect(fbuttons[loop], newpoint) then
  365.     begin
  366.       found := true;
  367.       if Flat then
  368.          Invalidate;
  369.       break;
  370.     end;
  371.     inc(loop);
  372.   end;
  373.  
  374.   if (found) and (loop < fWindowList.count) then
  375.   begin
  376.     f := TForm(FWindowList[loop]);
  377.     try
  378.       if assigned(f) and isWindow(f.handle) then
  379.       begin
  380.         tw := FLabelBMP.Canvas.TextWidth(f.Caption);
  381.         wrect := fbuttons[loop];
  382.         oldhint := fhint;
  383.         if tw > (((wrect.right - wrect.left) - 4) - 18) then
  384.           fhint := f.caption
  385.         else
  386.           fhint := '';
  387.         if oldhint <> fhint then
  388.         begin
  389.           if fhint <> '' then
  390.           begin
  391.             newpoint := ClientToScreen(point(wrect.Left, 0));
  392.             tw := FTaskHint.Canvas.TextWidth(fhint);
  393.             th := FTaskHint.Canvas.TextHeight(fhint);
  394.             WRect := Rect(newpoint.x, newpoint.y - th - 1, newpoint.x + tw + 8, newpoint.y + 2);
  395.             FTimer.Enabled := false;
  396.             FTaskHint.Tag := loop;
  397.             FTaskHint.ActivateHint(Wrect, fHint);
  398.             FTimer.Interval := fdelay;
  399.             FTimer.Enabled := true;
  400.           end
  401.           else
  402.             HideHint(true);
  403.         end;
  404.       end;
  405.     except
  406.       UnRegisterWindow(f);
  407.     end;
  408.   end
  409.   else
  410.     HideHint(true);
  411. end;
  412.  
  413. procedure TrmTaskBar.Notification(AComponent: TComponent;
  414.   Operation: TOperation);
  415. begin
  416.   inherited Notification(AComponent, Operation);
  417.   if AComponent is TCustomForm then
  418.   begin
  419.     if Operation = opRemove then
  420.       UnRegisterWindow(TForm(AComponent));
  421.  
  422.     if Operation = opInsert then
  423.       RegisterWindowTemp(TForm(AComponent));
  424.   end;
  425. end;
  426.  
  427. procedure TrmTaskBar.Paint;
  428. var
  429.   wrect: TRect;
  430.   btnsize: integer;
  431.   btncount: integer;
  432.   loop, xpos: integer;
  433.   F: TForm;
  434.   AddToList, BtnDown, updateList: boolean;
  435.   wCaption: string;
  436.   wIcon: TIcon;
  437.   wPt : TPoint;
  438. begin
  439.   inherited;
  440.  
  441.   if fTempList.Count > 0 then
  442.   begin
  443.     loop := fTempList.Count;
  444.     while loop > 0 do
  445.     begin
  446.       dec(loop);
  447.       if (TObject(ftemplist[loop]) is tcustomform) then
  448.       begin
  449.         f := TForm(ftemplist[loop]);
  450.         if f.HandleAllocated then
  451.         begin
  452.           ftemplist.Delete(loop);
  453.           AddToList := true;
  454.           if assigned(fOnAddingWindow) then
  455.             fOnAddingWindow(self, f, AddtoList);
  456.           if AddToList then RegisterWindow(f);
  457.         end;
  458.       end
  459.       else
  460.       begin
  461.         ftemplist.Delete(loop);
  462.       end;
  463.     end;
  464.   end;
  465.  
  466.   if (csdesigning in componentstate) then
  467.     btncount := 2
  468.   else
  469.     btncount := FWindowList.Count;
  470.  
  471.   updateList := high(fButtons) <> btncount;
  472.   if updatelist then
  473.     setlength(fButtons, btncount);
  474.  
  475.   fBufferBMP.Height := clientheight;
  476.   fBufferBMP.Width := clientwidth;
  477.   fBufferBMP.Canvas.Brush.color := fColor;
  478.   fbufferbmp.canvas.FillRect(ClientRect);
  479.   btnsize := maxbtnsize;
  480.   while LeftMargin + (btnsize * btncount) + (btnspace * btncount) + RightMargin > clientwidth do
  481.     dec(btnsize, 1);
  482.   if btnsize > maxbtnsize then btnsize := maxbtnsize;
  483.   if btnsize < minbtnsize then btnsize := minbtnsize;
  484.   loop := 0;
  485.   xpos := LeftMargin;
  486.   fLabelBMP.width := btnsize;
  487.   flabelbmp.height := btnheight;
  488.   while loop < btncount do
  489.   begin
  490.     if (csdesigning in componentstate) then
  491.     begin
  492.       case loop of
  493.         0:
  494.           begin
  495.             wcaption := 'Button Up';
  496.             BtnDown := false;
  497.           end;
  498.         1:
  499.           begin
  500.             wcaption := 'Button Down';
  501.             BtnDown := true;
  502.           end;
  503.       else
  504.         BtnDown := false;
  505.       end;
  506.     end
  507.     else
  508.     begin
  509.       f := TForm(fwindowlist[loop]);
  510.  
  511.       if fAutoHide then
  512.       begin
  513.         if (f.windowstate = wsminimized) and (f.FormStyle = fsMDIChild) then
  514.         begin
  515.           showwindow(f.handle, sw_hide);
  516.         end;
  517.  
  518.         if ((f.windowstate = wsnormal) or (f.Windowstate = wsmaximized)) and
  519.           (f.FormStyle = fsMDIChild) and (not iswindowvisible(f.handle)) then
  520.         begin
  521.           showwindow(f.handle, sw_show);
  522.         end;
  523.       end;
  524.  
  525.       if not f.icon.Empty then
  526.       begin
  527.         FIconBMP.Height := f.Icon.height;
  528.         FIconBMP.Width := f.Icon.width;
  529.         FIconBMP.Canvas.brush.color := fcolor;
  530.         fIconBmp.Canvas.FillRect(rect(0, 0, f.Icon.width, f.Icon.height));
  531.  
  532.         DrawIconEx(FIconBMP.Canvas.handle, 0, 0, f.Icon.handle, 16, 16, 0, 0, DI_NORMAL);
  533.  
  534.         fIconBMP.Transparent := true;
  535.         FIconBMP.TransparentColor := fcolor;
  536.       end
  537.       else if (f.FormStyle = fsmdiChild) then
  538.       begin
  539.         FIconBMP.Height := 16;
  540.         FIconBMP.Width := 16;
  541.         FIconBMP.Canvas.brush.color := fcolor;
  542.         fIconBmp.Canvas.FillRect(rect(0, 0, 16, 16));
  543.         wIcon := TIcon.create;
  544.         try
  545.           wIcon.Handle := LoadIcon(hinstance, makeintresource(0));
  546.  
  547.           if wIcon.Handle = 0 then
  548.             wIcon.Handle := LoadIcon(hinstance, 'MAINICON');
  549.  
  550.           DrawIconEx(FIconBMP.Canvas.handle, 0, 0, wIcon.handle, 16, 16, 0, 0, DI_NORMAL);
  551.         finally
  552.           wIcon.free;
  553.         end;
  554.         fIconBMP.Transparent := true;
  555.         FIconBMP.TransparentColor := fcolor;
  556.       end;
  557.       wCaption := f.caption;
  558.       if screen.activeForm <> Application.Mainform then
  559.         BtnDown := (screen.ActiveForm = f) and (f.windowstate <> wsminimized)
  560.       else
  561.         BtnDown := assigned(fLastActiveForm) and (fLastActiveForm = f) and (fLastActiveForm.windowstate <> wsminimized) and not (fMainFormFocused);
  562.     end;
  563.  
  564.     wrect := rect(0, 0, btnsize, btnheight);
  565.  
  566.     flabelbmp.Canvas.brush.color := fcolor;
  567.     flabelbmp.canvas.font := font;
  568.     flabelbmp.canvas.font.Color := clBtnText;
  569.     flabelbmp.canvas.fillrect(wrect);
  570.     if BtnDown then
  571.     begin
  572.       FLabelBMP.Canvas.Brush.Bitmap := AllocPatternBitmap(clBtnFace, clBtnHighlight);
  573.       FLabelBMP.Canvas.FillRect(wrect);
  574.       inflaterect(wrect, -2, -2);
  575.       flabelbmp.canvas.StretchDraw(rect(wrect.left + 2, wrect.top + 2, wrect.left + 18, wrect.top + 18), fIconBMP);
  576.       inflaterect(wrect, 2, 2);
  577.       if flat then
  578.       begin
  579.          frame3d(flabelbmp.canvas, wrect, cl3DDkShadow, clBtnHighlight, 1);
  580.          inflateRect(wRect, 1, 1);
  581.       end
  582.       else
  583.       begin
  584.          frame3d(flabelbmp.canvas, wrect, cl3DDkShadow, clBtnHighlight, 1);
  585.          frame3d(flabelbmp.canvas, wrect, clBtnShadow, cl3DLight, 1);
  586.       end;
  587.       wrect.left := wrect.left + 20;
  588.       wrect.top := wrect.top + 1;
  589.       wRect.right := wrect.right - 1;
  590.       FLabelBMP.Canvas.Font.Style := FLabelBMP.Canvas.Font.Style + [fsBold];
  591.       FLabelBMP.Canvas.Brush.Style := bsClear;
  592.       DrawText(flabelbmp.canvas.handle, pchar(wCaption), length(wCaption), wrect,
  593.         DT_END_ELLIPSIS or dt_VCenter or DT_SingleLine or DT_Left);
  594.     end
  595.     else
  596.     begin
  597.       inflaterect(wrect, -2, -2);
  598.       flabelbmp.canvas.StretchDraw(rect(wrect.left + 2, wrect.top + 1, wrect.left + 18, wrect.top + 17), fIconBMP);
  599.       inflaterect(wrect, 2, 2);
  600.       if flat then
  601.       begin
  602.          wPt := screentoclient(mouse.CursorPos);
  603.          if PtInRect(rect(xpos, TopMargin, xpos + btnsize, TopMargin + btnheight), wPt) then
  604.          begin
  605.             frame3d(flabelbmp.canvas, wrect, clBtnHighlight, cl3DDkShadow, 1);
  606.             inflateRect(wRect, 1, 1);
  607.          end;
  608.       end
  609.       else
  610.       begin
  611.          frame3d(flabelbmp.canvas, wrect, clBtnHighlight, cl3DDkShadow, 1);
  612.          frame3d(flabelbmp.canvas, wrect, cl3DLight, clBtnShadow, 1);
  613.       end;
  614.       wrect.left := wrect.left + 20;
  615.       wrect.top := wrect.top - 1;
  616.       wRect.right := wrect.right - 1;
  617.       FLabelBMP.Canvas.Font.Style := FLabelBMP.Canvas.Font.Style - [fsBold];
  618.       DrawText(flabelbmp.canvas.handle, pchar(wCaption), length(wCaption), wrect,
  619.         DT_END_ELLIPSIS or dt_VCenter or DT_SingleLine or DT_Left);
  620.     end;
  621.  
  622.     if updatelist then
  623.       fButtons[loop] := rect(xpos, TopMargin, xpos + btnsize, TopMargin + btnheight);
  624.  
  625.     fBufferBMP.canvas.Draw(xpos, TopMargin, flabelbmp);
  626.  
  627.     inc(xpos, btnsize + btnspace);
  628.     inc(loop);
  629.   end;
  630.   BitBlt(canvas.handle, 0, 0, clientwidth, clientheight, fBufferBMP.canvas.handle, 0, 0, SRCCOPY);
  631.  
  632.   if assigned(screen.ActiveForm) then
  633.   begin
  634.     fLastActiveForm := screen.ActiveForm;
  635.  
  636.     if (screen.ActiveForm.FormStyle = fsMDIChild) then
  637.     begin
  638.       try
  639.         fLastActiveMDIChild := screen.ActiveForm;
  640.       except
  641.         fLastActiveMDIChild := nil;
  642.       end;
  643.     end;
  644.   end;
  645. end;
  646.  
  647. procedure TrmTaskBar.RegisterWindow(F: TForm);
  648. var
  649.   loop: integer;
  650.   found: boolean;
  651.   Added: boolean;
  652. begin
  653.   loop := 0;
  654.   found := false;
  655.   while loop < fWindowlist.count do
  656.   begin
  657.     if fwindowlist[loop] = f then
  658.     begin
  659.       found := true;
  660.       break;
  661.     end;
  662.     inc(loop);
  663.   end;
  664.   if not found then
  665.   begin
  666.     added := false;
  667.  
  668.     if (((f.BorderStyle = bsToolWindow) or (f.BorderStyle = bsSizeToolWin)) and not (wtToolWin in fExcludeWinTypes)) or
  669.       ((f.BorderStyle = bsDialog) and not (wtDialog in fExcludeWinTypes)) or
  670.       ((f.FormStyle = fsMDIChild) and not (wtMDIChild in fExcludeWinTypes)) then
  671.     begin
  672.       fWindowList.add(f);
  673.       added := true;
  674.     end;
  675.  
  676.     if added then
  677.     begin
  678.       if assigned(fOnWindowAdded) then
  679.         fOnWindowAdded(self, f);
  680.       FreeNotification(f);
  681.       SetLength(fButtons, 0);
  682.     end;
  683.   end;
  684. end;
  685.  
  686. procedure TrmTaskBar.RegisterWindowTemp(F: TForm);
  687. begin
  688.     FTempList.Add(f);
  689.     invalidate;
  690. end;
  691.  
  692. procedure TrmTaskBar.SetAutoHide(const Value: boolean);
  693. var
  694.   loop: integer;
  695.   f: TForm;
  696. begin
  697.   fAutoHide := Value;
  698.  
  699.   if fAutoHide = false then
  700.   begin
  701.     loop := 0;
  702.     while loop < fwindowlist.count do
  703.     begin
  704.       f := TForm(fwindowlist[loop]);
  705.       if ((f.windowstate = wsnormal) or (f.Windowstate = wsmaximized)) and
  706.         (f.FormStyle = fsMDIChild) and (not iswindowvisible(f.handle)) then
  707.       begin
  708.         showwindow(f.handle, sw_show);
  709.       end;
  710.       inc(loop);
  711.     end;
  712.   end;
  713. end;
  714.  
  715. procedure TrmTaskBar.SetBtnHeight(const Value: integer);
  716. begin
  717.   fBtnHeight := Value;
  718.   invalidate;
  719. end;
  720.  
  721. procedure TrmTaskBar.SetBtnSpace(const Value: integer);
  722. begin
  723.   fBtnSpace := Value;
  724.   invalidate;
  725. end;
  726.  
  727. procedure TrmTaskBar.SetColor(const Value: TColor);
  728. begin
  729.   FColor := Value;
  730.   Repaint;
  731. end;
  732.  
  733. procedure TrmTaskBar.SetExcludes(const Value: TWinTypes);
  734. var
  735.   loop: integer;
  736.   f: TForm;
  737.   added, Removed: boolean;
  738. begin
  739.   if fExcludeWinTypes <> Value then
  740.   begin
  741.     fExcludeWinTypes := Value;
  742.     loop := FWindowList.Count;
  743.  
  744.     while loop > 0 do
  745.     begin
  746.       removed := false;
  747.       dec(loop);
  748.       f := FWindowList[loop];
  749.  
  750.       if ((wtToolWin in fExcludeWinTypes) and ((f.BorderStyle = bsToolWindow) or (f.BorderStyle = bsSizeToolWin))) or
  751.         ((wtDialog in fExcludeWinTypes) and (f.BorderStyle = bsDialog)) or
  752.         ((wtMDIChild in fExcludeWinTypes) and (f.FormStyle = fsMDIChild)) then
  753.       begin
  754.         fWindowList.delete(loop);
  755.         removed := true;
  756.       end;
  757.  
  758.       if removed then
  759.       begin
  760.         if assigned(fOnWindowRemoved) then
  761.           fOnWindowRemoved(self, f);
  762.         SetLength(fButtons, 0);
  763.       end;
  764.     end;
  765.  
  766.     for loop := 0 to screen.CustomFormCount - 1 do
  767.     begin
  768.       f := TForm(screen.CustomForms[loop]);
  769.       if fWindowList.indexof(f) = -1 then
  770.       begin
  771.         added := false;
  772.  
  773.         if (((f.BorderStyle = bsToolWindow) or (f.BorderStyle = bsSizeToolWin)) and not (wtToolWin in fExcludeWinTypes)) or
  774.           ((f.BorderStyle = bsDialog) and not (wtDialog in fExcludeWinTypes)) or
  775.           ((f.FormStyle = fsMDIChild) and not (wtMDIChild in fExcludeWinTypes)) then
  776.         begin
  777.           added := true;
  778.           fWindowList.add(f);
  779.         end;
  780.  
  781.         if added then
  782.         begin
  783.           if assigned(fOnWindowAdded) then
  784.             fOnWindowAdded(self, f);
  785.           FreeNotification(f);
  786.           SetLength(fButtons, 0);
  787.         end;
  788.       end;
  789.     end;
  790.     Invalidate;
  791.   end;
  792. end;
  793.  
  794. procedure TrmTaskBar.SetMaxBtnSize(const Value: integer);
  795. begin
  796.   fMaxBtnSize := Value;
  797.   invalidate;
  798. end;
  799.  
  800. procedure TrmTaskBar.SetMinBtnSize(const Value: integer);
  801. begin
  802.   fMinBtnSize := Value;
  803.   invalidate;
  804. end;
  805.  
  806. procedure TrmTaskBar.UnRegisterWindow(F: TForm);
  807. var
  808.   loop: integer;
  809.   found: boolean;
  810. begin
  811.   loop := 0;
  812.   found := false;
  813.   while loop < fTemplist.count do
  814.   begin
  815.     if fTemplist[loop] = f then
  816.     begin
  817.       found := true;
  818.       break;
  819.     end;
  820.     inc(loop);
  821.   end;
  822.   if found then
  823.   begin
  824.     fTemplist.Delete(loop);
  825.     SetLength(fButtons, 0);
  826.           //if we found it here then it wont be in FWindowList....
  827.     Exit;
  828.   end;
  829.  
  830.   loop := 0;
  831.   found := false;
  832.   while loop < fWindowlist.count do
  833.   begin
  834.     if fwindowlist[loop] = f then
  835.     begin
  836.       found := true;
  837.       break;
  838.     end;
  839.     inc(loop);
  840.   end;
  841.   if found then
  842.   begin
  843.     fWindowlist.Delete(loop);
  844.     if assigned(fOnWindowRemoved) then
  845.       fOnWindowRemoved(self, f);
  846.     SetLength(fButtons, 0);
  847.     Repaint;
  848.   end;
  849. end;
  850.  
  851. procedure TrmTaskBar.wmCommand(var msg: TMessage);
  852. begin
  853.   case loword(msg.wparam) of
  854.     SC_SIZE,
  855.       SC_MOVE,
  856.       SC_MINIMIZE,
  857.       SC_MAXIMIZE,
  858.       SC_NEXTWINDOW,
  859.       SC_PREVWINDOW,
  860.       SC_CLOSE,
  861.       SC_VSCROLL,
  862.       SC_HSCROLL,
  863.       SC_MOUSEMENU,
  864.       SC_KEYMENU,
  865.       SC_ARRANGE,
  866.       SC_RESTORE,
  867.       SC_TASKLIST,
  868.       SC_SCREENSAVE,
  869.       SC_HOTKEY,
  870.       SC_DEFAULT,
  871.       SC_MONITORPOWER,
  872.       SC_CONTEXTHELP,
  873.       SC_SEPARATOR:
  874.       begin
  875.         if assigned(fmenuWin) then
  876.           postmessage(fmenuwin.handle, wm_syscommand, msg.wparam, msg.lparam);
  877.         invalidate;
  878.       end;
  879.   else
  880.     if assigned(fmenuWin) then
  881.       postmessage(fmenuwin.handle, wm_command, msg.wparam, msg.lparam);
  882.   end;
  883. end;
  884.  
  885. procedure TrmTaskBar.SetLeftMargin(const Value: integer);
  886. begin
  887.   fLeftMargin := Value;
  888.   invalidate;
  889. end;
  890.  
  891. procedure TrmTaskBar.SetRightMargin(const Value: integer);
  892. begin
  893.   fRightMargin := Value;
  894.   invalidate;
  895. end;
  896.  
  897. procedure TrmTaskBar.SetTopMargin(const Value: integer);
  898. begin
  899.   fTopMargin := Value;
  900.   invalidate;
  901. end;
  902.  
  903. procedure TrmTaskBar.SetDelay(const Value: integer);
  904. begin
  905.   if fdelay <> value then
  906.     fdelay := value;
  907. end;
  908.  
  909. procedure TrmTaskBar.HideHint(ClearHint: Boolean);
  910. begin
  911.   FTaskHint.ReleaseHandle;
  912.   FTaskHint.Tag := -1;
  913.   if ClearHint then
  914.     fHint := '';
  915. end;
  916.  
  917. { ********** Windows Hooking Procedures ********** }
  918.  
  919. procedure TrmTaskBar.HookWin;
  920. begin
  921.   if csdesigning in componentstate then exit;
  922.   if not assigned(NewWndProc) then
  923.   begin
  924.     OldWndProc := TFarProc(GetWindowLong(TForm(Owner).handle, GWL_WNDPROC));
  925.     {$ifdef BD6}
  926.     NewWndProc := Classes.MakeObjectInstance(HookWndProc);
  927.     {$else}
  928.     NewWndProc := MakeObjectInstance(HookWndProc);
  929.     {$endif}
  930.     SetWindowLong(TForm(Owner).handle, GWL_WNDPROC, LongInt(NewWndProc));
  931.     if TForm(Owner).formstyle = fsMDIForm then HookMDIWin;
  932.   end;
  933. end;
  934.  
  935. procedure TrmTaskBar.UnhookWin;
  936. begin
  937.   if csdesigning in componentstate then exit;
  938.   if assigned(NewWndProc) then
  939.   begin
  940.     SetWindowLong(TForm(Owner).handle, GWL_WNDPROC, LongInt(OldWndProc));
  941.     if assigned(NewWndProc) then
  942.     {$ifdef BD6}
  943.        Classes.FreeObjectInstance(NewWndProc);
  944.     {$else}
  945.        FreeObjectInstance(NewWndProc);
  946.     {$endif}
  947.     NewWndProc := nil;
  948.   end;
  949.   UnHookMDIWin;
  950. end;
  951.  
  952. procedure TrmTaskBar.HookWndProc(var AMsg: TMessage);
  953. begin
  954.   case AMsg.msg of
  955.     WM_PARENTNOTIFY:
  956.       begin
  957.         if (AMsg.wParamLo <> wm_create) or (AMsg.wParamLo <> wm_Destroy) then
  958.           invalidate;
  959.       end;
  960.  
  961.     CM_ACTIVATE:
  962.       begin
  963.         fMainFormFocused := true;
  964.         invalidate;
  965.       end;
  966.   end;
  967.   AMsg.Result := CallWindowProc(OldWndProc, Tform(Owner).handle, AMsg.Msg, AMsg.wParam, AMsg.lParam);
  968.  
  969. {$IFDEF rmDebug}
  970.   if assigned(fWinMessage) then
  971.     fWinMessage(1, aMsg.msg);
  972. {$ENDIF}
  973. end;
  974.  
  975. procedure TrmTaskBar.HookMDIWin;
  976. begin
  977.   if csdesigning in componentstate then exit;
  978.   if not assigned(NewMDIWndProc) then
  979.   begin
  980.     OldMDIWndProc := TFarProc(GetWindowLong(TForm(Owner).ClientHandle, GWL_WNDPROC));
  981.     {$ifdef BD6}
  982.     NewMDIWndProc := Classes.MakeObjectInstance(HookMDIWndProc);
  983.     {$else}
  984.     NewMDIWndProc := MakeObjectInstance(HookMDIWndProc);
  985.     {$endif}
  986.     SetWindowLong(TForm(Owner).ClientHandle, GWL_WNDPROC, LongInt(NewMDIWndProc));
  987.   end;
  988. end;
  989.  
  990. procedure TrmTaskBar.UnhookMDIWin;
  991. begin
  992.   if csdesigning in componentstate then exit;
  993.   if assigned(NewMDIWndProc) then
  994.   begin
  995.     SetWindowLong(TForm(Owner).ClientHandle, GWL_WNDPROC, LongInt(OldMDIWndProc));
  996.     if assigned(NewMDIWndProc) then
  997.     {$ifdef BD6}
  998.        Classes.FreeObjectInstance(NewMDIWndProc);
  999.     {$else}
  1000.        FreeObjectInstance(NewMDIWndProc);
  1001.     {$endif}
  1002.     NewMDIWndProc := nil;
  1003.     OldMDIWndProc := nil;
  1004.   end;
  1005. end;
  1006.  
  1007. procedure TrmTaskBar.HookMDIWndProc(var AMsg: TMessage);
  1008. var
  1009.   loop: integer;
  1010. begin
  1011.   with AMsg do
  1012.   begin
  1013.     if not ((msg = WM_MDIGETACTIVE) or (msg = WM_NCPaint) or (msg = WM_NCHITTEST)) then
  1014.       Invalidate;
  1015.  
  1016.     if (msg = WM_MDIREFRESHMENU) and assigned(fMDIMenuRefresh) then
  1017.       fMDIMenuRefresh(self);
  1018.  
  1019.     Result := CallWindowProc(OldMDIWndProc, TForm(Owner).ClientHandle, Msg, wParam, lParam);
  1020.  
  1021.     if (msg = wm_parentNotify) then
  1022.     begin
  1023.       if WParamLo = WM_LBUTTONDOWN then
  1024.       begin
  1025.         for loop := WindowCount - 1 downto 0 do
  1026.         begin
  1027.           if PtInRect(WindowList[loop].BoundsRect, Point(LParamLo, LParamHi)) then
  1028.           begin
  1029.             if fMainFormFocused and assigned(fLastActiveMDIChild) and (WindowList[loop] = fLastActiveMDIChild) then
  1030.               DoDummyForm(fLastActiveMDIChild);
  1031.             break;
  1032.           end;
  1033.         end;
  1034.       end;
  1035.     end;
  1036.  
  1037.   end;
  1038.  
  1039. {$IFDEF rmDebug}
  1040.   if assigned(fWinMessage) then
  1041.     fWinMessage(2, aMsg.msg);
  1042. {$ENDIF}
  1043. end;
  1044.  
  1045. procedure TrmTaskBar.wmEraseBkgnd(var msg: TMessage);
  1046. begin
  1047.   msg.result := 1;
  1048. end;
  1049.  
  1050. function TrmTaskBar.GetActiveForm: TForm;
  1051. begin
  1052.   Result := fLastActiveForm;
  1053. end;
  1054.  
  1055. function TrmTaskBar.GetWindowCount: integer;
  1056. begin
  1057.   Result := FWindowList.Count;
  1058. end;
  1059.  
  1060. function TrmTaskBar.GetWindowItem(index: integer): TForm;
  1061. begin
  1062.   result := TForm(FWindowList[index]);
  1063. end;
  1064.  
  1065. function TrmTaskBar.GetMDIChild(index: integer): TForm;
  1066. var
  1067.   count: integer;
  1068.   loop: integer;
  1069. begin
  1070.   loop := 0;
  1071.   count := 0;
  1072.   result := nil;
  1073.   while loop < FWindowList.count do
  1074.   begin
  1075.     if TForm(fWindowList[loop]).FormStyle = fsMDIChild then
  1076.     begin
  1077.       if count = index then
  1078.       begin
  1079.         result := TForm(fWindowList[loop]);
  1080.         break;
  1081.       end;
  1082.       inc(count);
  1083.     end;
  1084.     inc(loop);
  1085.   end;
  1086. end;
  1087.  
  1088. function TrmTaskBar.GetMDIChildCount: integer;
  1089. var
  1090.   count: integer;
  1091.   loop: integer;
  1092. begin
  1093.   loop := 0;
  1094.   count := 0;
  1095.   while loop < FWindowList.count do
  1096.   begin
  1097.     if TForm(fWindowList[loop]).FormStyle = fsMDIChild then
  1098.       inc(count);
  1099.     inc(loop);
  1100.   end;
  1101.   result := count;
  1102. end;
  1103.  
  1104. function TrmTaskBar.GetActiveMDIChild: TForm;
  1105. begin
  1106.   Result := fLastActiveMDIChild;
  1107. end;
  1108.  
  1109. procedure TrmTaskBar.MinimizeAll;
  1110. begin
  1111.   MinimizeWindowTypes([wtMDIChild, wtDialog, wtToolWin]);
  1112. end;
  1113.  
  1114. procedure TrmTaskBar.MinimizeAllMDI;
  1115. begin
  1116.   MinimizeWindowTypes([wtMDIChild]);
  1117. end;
  1118.  
  1119. procedure TrmTaskBar.MinimizeWindowTypes(WinTypes: TWinTypes);
  1120. var
  1121.   loop: integer;
  1122.   f: TForm;
  1123. begin
  1124.   loop := 0;
  1125.   while loop < fWindowlist.count do
  1126.   begin
  1127.     f := fwindowlist[loop];
  1128.  
  1129.     if ((wtToolWin in WinTypes) and ((f.BorderStyle = bsToolWindow) or (f.BorderStyle = bsSizeToolWin))) or
  1130.       ((wtDialog in WinTypes) and (f.BorderStyle = bsDialog)) or
  1131.       ((wtMDIChild in WinTypes) and (f.FormStyle = fsMDIChild)) then
  1132.     begin
  1133.       f.WindowState := wsMinimized;
  1134.     end;
  1135.  
  1136.     inc(loop);
  1137.   end;
  1138. end;
  1139.  
  1140. procedure TrmTaskBar.DoDummyForm(ToggleForm: TForm);
  1141. var
  1142.   wControl : TWinControl;
  1143. begin
  1144.   if TForm(owner).formstyle = fsMDIForm then
  1145.   begin
  1146.      if ToggleForm.CanFocus then
  1147.      begin
  1148.         ToggleForm.SetFocus;
  1149.         if assigned(ToggleForm.ActiveControl) then
  1150.         begin
  1151.            wControl := ToggleForm.ActiveControl;
  1152.            ToggleForm.DefocusControl(ToggleForm.ActiveControl, False);
  1153.            ToggleForm.SetFocusedControl(wControl);
  1154.         end;
  1155.         fMainFormFocused := false;
  1156.         invalidate;
  1157.      end;
  1158.   end;
  1159. end;
  1160.  
  1161. procedure TrmTaskBar.wmDestroy(var msg: TMessage);
  1162. begin
  1163.   UnhookWin;
  1164. end;
  1165.  
  1166. procedure TrmTaskBar.SetFlat(const Value: boolean);
  1167. begin
  1168.   if fFlat <>  value then
  1169.   begin
  1170.     fFlat := Value;
  1171.     Invalidate;
  1172.   end;
  1173. end;
  1174.  
  1175. end.
  1176.  
  1177.