home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d56 / RMCTL.ZIP / rmCaptionButtons.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-22  |  22KB  |  783 lines
  1. {================================================================================
  2. Copyright (C) 1997-2001 Mills Enterprise
  3.  
  4. Unit     : rmCaptionButtons
  5. Purpose  : Allows for new caption bar buttons to be defined.
  6. Date     : 06-18-1998
  7. Author   : Ryan J. Mills
  8. Version  : 1.80
  9. ================================================================================}
  10.  
  11. unit rmCaptionButtons;
  12.  
  13. interface
  14.  
  15. {$I CompilerDefines.INC}
  16.  
  17. uses
  18.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, extctrls,
  19.   imglist;
  20.  
  21. type
  22.   TrmCaptionButtonStyle = (cbsButton, cbsSpacer);
  23.  
  24.   TrmCaptionButtonItem = class(TCollectionItem)
  25.   private
  26.     fimageindex: integer;
  27.     fStyle: TrmCaptionButtonStyle;
  28.     fwidth: integer;
  29.     fcaption: string;
  30.     fvisible: boolean;
  31.     fEnabled: boolean;
  32.     procedure setimageindex(value: integer);
  33.     procedure SetStyle(value: TrmCaptionButtonStyle);
  34.     procedure setwidth(value: integer);
  35.     function GetRect: TRect;
  36.     function GetCapBtnRect: TRect;
  37.     procedure SetCaption(value: string);
  38.     procedure SetVisible(value: boolean);
  39.     procedure SetEnabled(const Value: boolean);
  40.   public
  41.     constructor Create(Collection: TCollection); override;
  42.     procedure Assign(Source: TPersistent); override;
  43.     procedure hide;
  44.     procedure show;
  45.     property ButtonRect: trect read GetRect;
  46.     property CapBtnRect: TRect read GetCapBtnRect;
  47.   published
  48.     property Enabled : boolean read fEnabled write SetEnabled default true;
  49.     property ImageIndex: integer read fimageindex write setimageindex default -1;
  50.     property Style: TrmCaptionButtonStyle read fstyle write setStyle default cbsbutton;
  51.     property Width: integer read fwidth write setwidth default 5;
  52.     property Caption: string read fcaption write setcaption;
  53.     property Visible: boolean read fvisible write setvisible default true;
  54.   end;
  55.  
  56.   TrmCaptionButtonsCollection = class(TCollection)
  57.   private
  58.     FOwner: TPersistent;
  59.     function GetItem(Index: Integer): TrmCaptionButtonItem;
  60.     procedure SetItem(Index: Integer; Value: TrmCaptionButtonItem);
  61.   protected
  62.     function GetOwner: TPersistent; override;
  63.   public
  64.     constructor Create(AOwner: TPersistent);
  65.     function Add: TrmCaptionButtonItem;
  66.     function ExcludeBtnRgn(R: TRect): TRect;
  67.     function GetCaptionRect: TRect;
  68.     function ButtonsRect: TRect;
  69.     property Items[Index: Integer]: TrmCaptionButtonItem read GetItem write SetItem; default;
  70.   end;
  71.  
  72.   TrmCaptionButtonClick = procedure(ButtonIndex: integer) of object;
  73.  
  74.   TrmCaptionButtons = class(TComponent)
  75.   private
  76.     { Private declarations }
  77.     fbuttons: TrmCaptionButtonsCollection;
  78.     fimages: TCustomImageList;
  79.     FImageChangeLink: TChangeLink;
  80.     ffont: TFont;
  81.     fCanvas: TCanvas;
  82.  
  83.     OldWndProc: TFarProc;
  84.     NewWndProc: Pointer;
  85.  
  86.     fPaintButtons: boolean;
  87.     paintingbutton: boolean;
  88.     fvisible: boolean;
  89.     fncButtonID: integer;
  90.     fncmousedown: boolean;
  91.     fncmousedownrect: trect;
  92.  
  93.     fCapBtnClick: TrmCaptionButtonClick;
  94.  
  95.     function calcPoint(x, y: integer): tpoint;
  96.     procedure SetVisible(value: boolean);
  97.     procedure SetFont(value: TFont);
  98.     procedure CMTextChanged(var msg: TMessage); message CM_TextChanged;
  99.     function GetOwnerAsForm: TForm;
  100.     procedure SetImages(const Value: TCustomImagelist);
  101.     procedure ImageListChange(Sender: TObject);
  102.  
  103.   protected
  104.     { Protected declarations }
  105.     procedure PaintButtons(pt: tpoint);
  106.     function BtnEnabled(pt:TPoint):boolean;
  107.  
  108.     procedure HookWndProc(var WorkMsg: TMessage);
  109.     procedure HookWin;
  110.     procedure UnhookWin;
  111.  
  112.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  113.   public
  114.     { Public declarations }
  115.     constructor create(AOwner: TComponent); override;
  116.     destructor destroy; override;
  117.  
  118.     procedure updatecaption;
  119.     procedure Show;
  120.     procedure Hide;
  121.   published
  122.     { Published declarations }
  123.     property Buttons: TrmCaptionButtonsCollection read fbuttons write fbuttons;
  124.     property Visible: boolean read fvisible write SetVisible default true;
  125.     property Images: TCustomImagelist read fimages write SetImages;
  126.     property Font: TFont read ffont write Setfont;
  127.     property OnClick: TrmCaptionButtonClick read fCapBtnClick write fCapBtnClick;
  128.   end;
  129.  
  130. implementation
  131.  
  132. uses rmGlobalComponentHook;
  133.  
  134. { TrmCaptionButtonItem }
  135.  
  136. constructor TrmCaptionButtonItem.Create(Collection: TCollection);
  137. begin
  138.   fimageindex := -1;
  139.   fvisible := true;
  140.   fEnabled := true;
  141.   inherited Create(Collection);
  142. end;
  143.  
  144. procedure TrmCaptionButtonItem.Assign(Source: TPersistent);
  145. begin
  146.   if Source is TrmCaptionButtonItem then
  147.   begin
  148.     imageindex := TrmCaptionButtonItem(Source).imageindex;
  149.     Exit;
  150.   end;
  151.   inherited Assign(Source);
  152. end;
  153.  
  154. procedure TrmCaptionButtonItem.setimageindex(value: integer);
  155. begin
  156.   fimageindex := value;
  157.   Changed(False);
  158. end;
  159.  
  160. procedure TrmCaptionButtonItem.SetStyle(value: TrmCaptionButtonStyle);
  161. begin
  162.   fstyle := value;
  163.   changed(false);
  164. end;
  165.  
  166. procedure TrmCaptionButtonItem.setwidth(value: integer);
  167. begin
  168.   fwidth := value;
  169.   changed(false);
  170. end;
  171.  
  172. function TrmCaptionButtonItem.GetCapBtnRect: TRect;
  173. var
  174.   r: trect;
  175.   loop: integer;
  176. begin
  177.   with TrmCaptionButtonsCollection(collection) do
  178.   begin
  179.     r := buttonsrect;
  180.     for loop := index - 1 downto 0 do
  181.       if items[loop].visible then r.left := r.left + items[loop].width;
  182.     r.right := r.left + items[index].width;
  183.     r.top := r.top + 2;
  184.     r.bottom := r.bottom - 2;
  185.     result := r;
  186.   end;
  187. end;
  188.  
  189. function TrmCaptionButtonItem.GetRect: TRect;
  190. var
  191.   r: trect;
  192.   loop: integer;
  193. begin
  194.   with TrmCaptionButtonsCollection(collection) do
  195.   begin
  196.     r := excludebtnrgn(GetCaptionrect);
  197.     r := rect(0, 0, 0, r.bottom - r.top);
  198.     for loop := 0 to index - 1 do
  199.       if items[loop].visible then r.left := r.left + items[loop].width;
  200.     r.right := r.left + items[index].width;
  201.     r.top := r.top + 2;
  202.     r.bottom := r.bottom - 2;
  203.     result := r;
  204.   end;
  205. end;
  206.  
  207. procedure TrmCaptionButtonItem.setCaption(value: string);
  208. begin
  209.   fcaption := value;
  210.   changed(false);
  211. end;
  212.  
  213. procedure TrmCaptionButtonItem.setvisible(value: boolean);
  214. begin
  215.   fvisible := value;
  216.   changed(false);
  217. end;
  218.  
  219. procedure TrmCaptionButtonItem.hide;
  220. begin
  221.   fvisible := false;
  222.   changed(false);
  223. end;
  224.  
  225. procedure TrmCaptionButtonItem.show;
  226. begin
  227.   fvisible := true;
  228.   changed(false);
  229. end;
  230.  
  231. procedure TrmCaptionButtonItem.SetEnabled(const Value: boolean);
  232. begin
  233.   fEnabled := Value;
  234.   changed(false);
  235. end;
  236.  
  237. { TrmCaptionButtonsCollection }
  238.  
  239. constructor TrmCaptionButtonsCollection.Create(AOwner: TPersistent);
  240. begin
  241.   inherited Create(TrmCaptionButtonItem);
  242.   fOwner := AOwner;
  243. end;
  244.  
  245. function TrmCaptionButtonsCollection.Add: TrmCaptionButtonItem;
  246. begin
  247.   Result := TrmCaptionButtonItem(inherited Add);
  248. end;
  249.  
  250. function TrmCaptionButtonsCollection.GetItem(Index: Integer): TrmCaptionButtonItem;
  251. begin
  252.   Result := TrmCaptionButtonItem(inherited GetItem(Index));
  253. end;
  254.  
  255. function TrmCaptionButtonsCollection.GetOwner: TPersistent;
  256. begin
  257.   Result := fOwner;
  258. end;
  259.  
  260. procedure TrmCaptionButtonsCollection.SetItem(Index: Integer; Value: TrmCaptionButtonItem);
  261. begin
  262.   inherited SetItem(Index, Value);
  263. end;
  264.  
  265. function TrmCaptionButtonsCollection.ExcludeBtnRgn(R: TRect): TRect;
  266. var
  267.   BtnWidth: integer;
  268.   BS: TFormBorderStyle;
  269.   BI: TBorderIcons;
  270. begin
  271.   BS := TForm(GetOwner).BorderStyle;
  272.   if BS = bsNone then exit;
  273.   BtnWidth := GetSystemMetrics(SM_CXSIZE);
  274.   if BS in [bsToolWindow, bsSizeToolWin] then
  275.   begin
  276.     R.Right := R.Right - GetSystemMetrics(SM_CXSMSIZE) - 2; { close icon only }
  277.     result := r;
  278.     exit;
  279.   end;
  280.  
  281.   BI := TForm(GetOwner).BorderIcons;
  282.  
  283.   if (biSystemMenu in BI)
  284.     then R.Right := R.Right - BtnWidth - 2; { close icon - this is OS dependant }
  285.   if ((BS <> bsDialog) and ((biMinimize in BI) or (biMaximize in BI)))
  286.     then R.Right := R.Right - 2 * BtnWidth; { minimise and maximise icon }
  287.  
  288.   if ((BS = bsDialog) and (biHelp in BI))
  289.     then R.Right := R.Right - BtnWidth - 2 { help icon }
  290.   else R.Right := R.Right - 2;
  291.  
  292.   result := r;
  293. end;
  294.  
  295. function TrmCaptionButtonsCollection.GetCaptionRect: TRect;
  296. var
  297.   BS: TFormBorderStyle;
  298. begin
  299.   BS := TForm(GetOwner).BorderStyle;
  300.  
  301.   { if we have no border style, then just set the rectangle empty. }
  302.   if BS = bsNone then
  303.   begin
  304.     SetRectEmpty(Result);
  305.     exit;
  306.   end;
  307.  
  308.   GetWindowRect(TForm(GetOwner).handle, Result);
  309.   { Convert rect from screen (absolute) to client (0 based) coordinates. }
  310.   OffsetRect(Result, -Result.Left, -Result.Top);
  311.   { Shrink rectangle to allow for window border.  We let Windows paint the border. }
  312.      { this catches drawing MDI minimised windows caption bars in Win95 }
  313.   if ((GetWindowLong(TForm(GetOwner).handle, GWL_STYLE) and WS_MINIMIZE) <> 0)
  314.     then InflateRect(Result, -GetSystemMetrics(SM_CXFIXEDFRAME),
  315.       -GetSystemMetrics(SM_CYFIXEDFRAME))
  316.   else
  317.     case BS of
  318.       bsToolWindow, bsSingle, bsDialog:
  319.         InflateRect(Result, -GetSystemMetrics(SM_CXFIXEDFRAME),
  320.           -GetSystemMetrics(SM_CYFIXEDFRAME));
  321.       bsSizeToolWin, bsSizeable:
  322.         InflateRect(Result, -GetSystemMetrics(SM_CXSIZEFRAME),
  323.           -GetSystemMetrics(SM_CYSIZEFRAME));
  324.     end;
  325.      { Set the appropriate height of caption bar. }
  326.   if BS in [bsToolWindow, bsSizeToolWin] then
  327.     Result.Bottom := Result.Top + GetSystemMetrics(SM_CYSMCAPTION) - 1
  328.   else
  329.     Result.Bottom := Result.Top + GetSystemMetrics(SM_CYCAPTION) - 1;
  330. end; { GetTitleBarRect }
  331.  
  332. function TrmCaptionButtonsCollection.ButtonsRect: TRect;
  333. var
  334.   r: trect;
  335.   loop: integer;
  336. begin
  337.   r := excludebtnrgn(GetCaptionrect);
  338.   r.left := r.right;
  339.   for loop := 0 to count - 1 do
  340.     if items[loop].visible then r.left := r.left - items[loop].width;
  341.   result := r;
  342. end;
  343.  
  344. { TrmCaptionButtons }
  345.  
  346. constructor TrmCaptionButtons.create(AOwner: TComponent);
  347. begin
  348.   inherited create(AOwner);
  349.  
  350.   OldWndProc := nil;
  351.   NewWndProc := nil;
  352.  
  353.   fcanvas := tcanvas.create;
  354.   fbuttons := TrmCaptionButtonsCollection.create(Aowner);
  355.  
  356.   fncmousedown := false;
  357.   fncmousedownrect := rect(0, 0, 0, 0);
  358.   fPaintButtons := true;
  359.   fvisible := true;
  360.  
  361.   FImageChangeLink := TChangeLink.Create;
  362.   FImageChangeLink.OnChange := ImageListChange;
  363.  
  364.   FFont := TFont.create;
  365.   ffont.assign(GetOwnerAsForm.Font);
  366.  
  367.   HookWin;
  368. end;
  369.  
  370. destructor TrmCaptionButtons.destroy;
  371. begin
  372.   UnHookWin;
  373.  
  374.   fbuttons.free;
  375.   fcanvas.free;
  376.   ffont.free;
  377.  
  378.   inherited;
  379. end;
  380.  
  381. procedure TrmCaptionButtons.HookWin;
  382. begin
  383.   if csdesigning in componentstate then exit;
  384.   if not assigned(NewWndProc) then
  385.   begin
  386.     OldWndProc := TFarProc(GetWindowLong(GetOwnerAsForm.Handle, GWL_WNDPROC));
  387.     {$ifdef BD6}
  388.     NewWndProc := Classes.MakeObjectInstance(HookWndProc);
  389.     {$else}
  390.     NewWndProc := MakeObjectInstance(HookWndProc);
  391.     {$endif}
  392.     SetWindowLong(GetOwnerAsForm.Handle, GWL_WNDPROC, LongInt(NewWndProc));
  393.     PushOldProc(GetOwnerAsForm, OldWndProc);
  394.   end;
  395. end; { HookWin }
  396.  
  397. procedure TrmCaptionButtons.UnhookWin;
  398. begin
  399.   if csdesigning in componentstate then exit;
  400.   if assigned(NewWndProc) then
  401.   begin
  402.     SetWindowLong(GetOwnerAsForm.Handle, GWL_WNDPROC, LongInt(PopOldProc(GetOwnerAsForm)));
  403.     if assigned(NewWndProc) then
  404.     {$ifdef BD6}
  405.        Classes.FreeObjectInstance(NewWndProc);
  406.     {$else}
  407.        FreeObjectInstance(NewWndProc);
  408.     {$endif}
  409.     oldWndProc := nil;
  410.     NewWndProc := nil;
  411.   end;
  412. end; { UnHookWin }
  413.  
  414. function TrmCaptionButtons.calcPoint(x, y: integer): tpoint;
  415. var
  416.   wp: tpoint;
  417. begin
  418.   with GetOwnerAsForm do
  419.     case WindowState of
  420.       wsnormal: wp := point(x - left, y - top);
  421.       wsMaximized: wp := point(x, y);
  422.       wsMinimized: wp := point(x - left, y - top);
  423.     end;
  424.   if GetOwnerAsForm.left < 0 then inc(wp.x, abs(GetOwnerAsForm.left));
  425.   if GetOwnerAsForm.top < 0 then inc(wp.y, abs(GetOwnerAsForm.top));
  426.   result := wp;
  427. end;
  428.  
  429. procedure TrmCaptionButtons.HookWndProc(var WorkMsg: TMessage);
  430. var
  431.   xpos, ypos: integer;
  432.   wp: tpoint;
  433.   myMsg: Cardinal;
  434.   oldBtnID : integer;
  435. begin
  436.   with WorkMsg do
  437.   begin
  438.     MyMsg := msg;
  439.     case MyMsg of
  440.       WM_DESTROY:
  441.         begin
  442.           Result := CallWindowProc(OldWndProc, GetOwnerAsForm.handle, WorkMsg.Msg, WorkMsg.wParam, WorkMsg.lParam);
  443.           UnHookWin;
  444.           UpdateCaption;
  445.           exit;
  446.         end;
  447.  
  448.       WM_ERASEBKGND:
  449.         if paintingbutton then
  450.         begin
  451.           result := 0;
  452.           exit;
  453.         end;
  454.  
  455.       WM_NCLBUTTONDBLCLK:
  456.         begin
  457.           xpos := TWMNCLButtonDown(WorkMsg).xcursor;
  458.           ypos := TWMNCLButtonDown(WorkMsg).ycursor;
  459.           wp := calcPoint(xpos, ypos);
  460.           if (fvisible) and ptinrect(fButtons.ButtonsRect, wp) then
  461.           begin
  462.             if BtnEnabled(wp) then
  463.             begin
  464.                fncmousedown := true;
  465.                PaintButtons(wp);
  466.             end;
  467.             result := 0;
  468.             exit;
  469.           end
  470.         end;
  471.  
  472.       wm_nchittest:
  473.         begin
  474.           Result := CallWindowProc(OldWndProc, GetOwnerAsForm.handle, MyMsg, wParam, lParam);
  475.           if result = htCaption then
  476.           begin
  477.             xpos := twmncHitTest(WorkMsg).xpos;
  478.             ypos := twmncHitTest(WorkMsg).ypos;
  479.             wp := GetOwnerAsForm.screentoclient(calcPoint(xpos, ypos));
  480.             if (fvisible) and ptinrect(fButtons.ButtonsRect, wp) and (fNCMouseDown) then
  481.             begin
  482.               if fNCButtonId <> -1 then PaintButtons(point(-1, -1));
  483.               result := 0;
  484.               exit;
  485.             end;
  486.           end
  487.           else
  488.           begin
  489.             PaintButtons(point(-1, -1));
  490.           end;
  491.         end;
  492.  
  493.       WM_NCLButtonDown:
  494.         begin
  495.           xpos := TWMNCLButtonDown(WorkMsg).xcursor;
  496.           ypos := TWMNCLButtonDown(WorkMsg).ycursor;
  497.           wp := calcPoint(xpos, ypos);
  498.           if (fvisible) and ptinrect(fButtons.ButtonsRect, wp) then
  499.           begin
  500.             if BtnEnabled(wp) then
  501.             begin
  502.                fncmousedown := true;
  503.                PaintButtons(wp);
  504.             end;
  505.             result := 0;
  506.             exit;
  507.           end
  508.         end;
  509.  
  510.       WM_NCMouseMove:
  511.         begin
  512.           xpos := TWMNCLButtonDown(WorkMsg).xcursor;
  513.           ypos := TWMNCLButtonDown(WorkMsg).ycursor;
  514.           wp := calcPoint(xpos, ypos);
  515.           if (fvisible) and ptinrect(fncMouseDownRect, wp) and (fNCMouseDown) then
  516.           begin
  517.             if fNCButtonId = -1 then PaintButtons(wp);
  518.             result := 0;
  519.             exit;
  520.           end;
  521.           if (fNCButtonId <> -1) then PaintButtons(point(-1, -1));
  522.         end;
  523.  
  524.       WM_NCLButtonUp:
  525.         begin
  526.           xpos := TWMNCLButtonUp(WorkMsg).xcursor;
  527.           ypos := TWMNCLButtonUp(WorkMsg).ycursor;
  528.           wp := calcPoint(xpos, ypos);
  529.  
  530.           if (fvisible) and ptinrect(fncMouseDownRect, wp) and (fNCMouseDown) then
  531.           begin
  532.             OldBtnID := fncButtonID;
  533.             fncmousedown := false;
  534.             Result := 0;
  535.             PaintButtons(point(-1, -1));
  536.  
  537.             if assigned(fCapBtnClick) then
  538.                fCapBtnClick(OldBtnID);
  539.             exit;
  540.           end;
  541.           fncmousedown := false;
  542.         end;
  543.     end;
  544.  
  545.     Result := CallWindowProc(OldWndProc, (Owner as TForm).handle, MyMsg, wParam, lParam);
  546.  
  547.     case MyMsg of
  548.       WM_NCPAINT: PaintButtons(point(-1, -1));
  549.       WM_NCACTIVATE: PaintButtons(point(-1, -1));
  550.       WM_MouseMove: if (fNCButtonId <> -1) then PaintButtons(point(-1, -1));
  551.       WM_LButtonUp: if fncmousedown then
  552.         begin
  553.           fncmousedown := false;
  554.           PaintButtons(point(-1, -1));
  555.         end;
  556.     end;
  557.   end;
  558. end; { HookWndProc }
  559.  
  560. procedure TrmCaptionButtons.PaintButtons(pt: tpoint);
  561. var
  562.   btnrect: trect;
  563.   loop: integer;
  564.   x, y: integer;
  565.   bmp: TBitmap;
  566.   tc1, tc2, bc1, bc2: TColor;
  567. //  xadj, yadj: integer;
  568.   wItem : TrmCaptionButtonItem;
  569.   wDrawFlags : UInt;
  570.   wBtnDown : boolean;
  571. begin
  572.   if (fPaintButtons = false) or (fvisible = false) then exit;
  573.   bmp := tbitmap.create;
  574.   fcanvas.handle := getwindowdc(GetOwnerAsForm.handle);
  575.   PaintingButton := true;
  576.   try
  577.     btnrect := fbuttons.buttonsrect;
  578.     bmp.Width := btnrect.Right - btnrect.left;
  579.     bmp.height := btnrect.bottom - btnrect.top;
  580.     bmp.Canvas.CopyRect(rect(0, 0, bmp.width, bmp.height), fcanvas, btnrect);
  581.     bmp.canvas.font.assign(font);
  582.     fNCbuttonID := -1;
  583.  
  584.     wDrawFlags := DT_VCenter or DT_CENTER or DT_NOPREFIX or DT_SINGLELINE;
  585.     for loop := 0 to fbuttons.count - 1 do
  586.     begin
  587.       wItem := fbuttons[loop];
  588.       if wItem.style = cbsbutton then
  589.       begin
  590.         btnrect := wItem.ButtonRect;
  591.         bmp.canvas.brush.Color := clbtnface;
  592.         bmp.canvas.FillRect(btnrect);
  593.         if ptinrect(wItem.CapBtnRect, pt) then
  594.         begin
  595.           tc1 := cl3dDkShadow;
  596.           tc2 := clbtnShadow;
  597.           bc1 := clbtnhighlight;
  598.           bc2 := cl3dlight;
  599.           fNCbuttonID := loop;
  600.           fncmousedownrect := wItem.CapBtnRect;
  601.           wBtnDown := true;
  602.         end
  603.         else
  604.         begin
  605.           tc1 := clbtnhighlight;
  606.           tc2 := cl3dlight;
  607.           bc1 := cl3dDkShadow;
  608.           bc2 := clbtnShadow;
  609.           wBtnDown := false;
  610.         end;
  611.  
  612.         frame3d(bmp.canvas, btnrect, tc1, bc1, 1);
  613.         frame3d(bmp.canvas, btnrect, tc2, bc2, 1);
  614.  
  615.         if assigned(fimages) and (wItem.imageindex <> -1) then
  616.         begin
  617.           y := btnrect.top + ((btnrect.bottom - btnrect.top) shr 1) - (fimages.height shr 1);
  618.           x := btnrect.left + ((btnrect.right - btnrect.left) shr 1) - (fimages.width shr 1);
  619.           inc(x);
  620.           inc(y);
  621.         end
  622.         else
  623.         begin
  624.           y := btnrect.top + ((btnrect.bottom - btnrect.top) shr 1) - (bmp.canvas.textheight(fbuttons[loop].caption) shr 1);
  625.           x := btnrect.left + ((btnrect.right - btnrect.left) shr 1) - (bmp.canvas.textwidth(fbuttons[loop].caption) shr 1);
  626.         end;
  627.         if assigned(fimages) and (wItem.imageindex <> -1) then
  628.         begin
  629.            if wBtnDown then
  630.               fimages.Draw(bmp.canvas, x, y, wItem.imageindex)
  631.            else
  632.               fimages.Draw(bmp.canvas, x-1, y-1, wItem.imageindex);
  633.         end
  634.         else
  635.         begin
  636.              bmp.Canvas.brush.Style := bsClear;
  637.              if not wbtnDown then
  638.                 OffsetRect(btnrect, -1, -1);
  639.              try
  640.                 if wItem.enabled then
  641.                    DrawText(bmp.Canvas.handle, pchar(wItem.Caption), length(wItem.Caption), btnRect, wDrawFlags)
  642.                 else
  643.                 begin
  644.                    bmp.Canvas.Font.Color := clBtnHighlight;
  645.                    try
  646.                       DrawText(bmp.Canvas.handle, pchar(wItem.Caption), length(wItem.Caption), btnRect, wDrawFlags);
  647.                       bmp.Canvas.Font.Color := clBtnShadow;
  648.                       OffsetRect(btnrect, -1, -1);
  649.                       DrawText(bmp.Canvas.handle, pchar(wItem.Caption), length(wItem.Caption), btnRect, wDrawFlags);
  650.                       OffsetRect(btnrect, 1, 1);
  651.                    finally
  652.                       bmp.canvas.font.color := clBtnText;
  653.                    end
  654.                 end;
  655.              finally
  656.                 if not wBtnDown then
  657.                    OffsetRect(btnrect, 1, 1);
  658.                 bmp.Canvas.brush.Style := bsSolid;
  659.              end;
  660.         end;
  661.       end;
  662.     end;
  663.     btnrect := fbuttons.buttonsrect;
  664.     fcanvas.draw(btnrect.left, btnrect.top, bmp);
  665.   finally
  666.     bmp.free;
  667.     if fcanvas.handle <> 0 then
  668.       releasedc(GetOwnerAsForm.handle, fcanvas.handle);
  669.     fcanvas.handle := 0;
  670.     PaintingButton := false;
  671.   end;
  672. end;
  673.  
  674. procedure TrmCaptionButtons.updatecaption;
  675. begin
  676.   try
  677.      fPaintButtons := false;
  678.      SetWindowPos(GetOwnerAsForm.handle, 0, 0, 0, 0, 0,
  679.        SWP_FRAMECHANGED or SWP_DRAWFRAME or
  680.        SWP_NOZORDER or SWP_NOMOVE or SWP_NOSIZE);
  681.      fPaintButtons := true;
  682.      SetWindowPos(GetOwnerAsForm.handle, 0, 0, 0, 0, 0,
  683.        SWP_FRAMECHANGED or SWP_DRAWFRAME or
  684.        SWP_NOZORDER or SWP_NOMOVE or SWP_NOSIZE);
  685.   except
  686.      //Do Nothing   
  687.   end;
  688. end;
  689.  
  690.  
  691. procedure TrmCaptionButtons.Show;
  692. begin
  693.   fvisible := true;
  694.   updatecaption;
  695. end;
  696.  
  697. procedure TrmCaptionButtons.Hide;
  698. begin
  699.   fvisible := false;
  700.   updatecaption;
  701. end;
  702.  
  703. procedure TrmCaptionButtons.SetVisible(value: boolean);
  704. begin
  705.   case value of
  706.     true: show;
  707.     false: hide;
  708.   end;
  709. end;
  710.  
  711. procedure TrmCaptionButtons.SetFont(value: Tfont);
  712. begin
  713.   ffont.assign(value);
  714.   PaintButtons(Point(-1,-1));
  715. end;
  716.  
  717. procedure TrmCaptionButtons.CMTextChanged(var msg: TMessage);
  718. begin
  719.   inherited;
  720.   PaintButtons(point(-1, -1));
  721. end;
  722.  
  723. function TrmCaptionButtons.GetOwnerAsForm: TForm;
  724. begin
  725.    if (owner is TForm) then
  726.    begin
  727.      result := TForm(Owner);
  728.      if not result.handleallocated then
  729.        result.handleneeded;
  730.    end
  731.    else
  732.      result := nil;
  733. end;
  734.  
  735. procedure TrmCaptionButtons.Notification(AComponent: TComponent;
  736.   Operation: TOperation);
  737. begin
  738.   inherited;
  739.   if operation = opremove then
  740.   begin
  741.      if (AComponent = Images) then
  742.         Images := nil;
  743.   end;
  744. end;
  745.  
  746. procedure TrmCaptionButtons.SetImages(const Value: TCustomImagelist);
  747. begin
  748.   if Images <> nil then
  749.     Images.UnRegisterChanges(FImageChangeLink);
  750.   FImages := Value;
  751.   if Images <> nil then
  752.   begin
  753.     Images.RegisterChanges(FImageChangeLink);
  754.     Images.FreeNotification(Self);
  755.   end;
  756.  
  757.   if Not (csdestroying in componentstate) then 
  758.      PaintButtons(point(-1,-1));
  759. end;
  760.  
  761. procedure TrmCaptionButtons.ImageListChange(Sender: TObject);
  762. begin
  763.    PaintButtons(point(-1,-1));
  764. end;
  765.  
  766. function TrmCaptionButtons.BtnEnabled(pt: TPoint): boolean;
  767. var
  768.    loop : integer;
  769. begin
  770.    result := false;
  771.    for loop := 0 to fbuttons.Count-1 do
  772.    begin
  773.       if ptinrect(fbuttons.Items[loop].CapBtnRect, pt) then
  774.       begin
  775.          Result := fbuttons.Items[loop].Enabled;
  776.          break;
  777.       end;
  778.    end;
  779. end;
  780.  
  781. end.
  782.  
  783.