home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kolekce / d56 / TDSOFT.ZIP / TDSuperButton.pas < prev    next >
Pascal/Delphi Source File  |  2001-04-06  |  2KB  |  100 lines
  1. unit TDSuperButton;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Dialogs,
  7.   StdCtrls;
  8.  
  9. type
  10.   TTDSuperButton = class(TButton)
  11.   private
  12.     FMultiline: Boolean;
  13.     FHoverStyles: TFontStyles;
  14.     { Private declarations }
  15.     procedure SetMultiline(const Value: Boolean);
  16.     procedure SetHoverStyles(const Value: TFontStyles);
  17.   protected
  18.     { Protected declarations }
  19.     procedure CMMOUSEENTER(var Mes: TMessage); message CM_MOUSEENTER;
  20.     procedure CMMOUSELEAVE(var Mes: TMessage); message CM_MOUSELEAVE;
  21.     procedure WMPAINT(var Mes: TMessage);message WM_PAINT;
  22.     procedure WMERASEBKGND(var Mes: TMessage);message WM_ERASEBKGND;
  23.     procedure CreateParams(var Params: TCreateParams); override;
  24.   public
  25.     { Public declarations }
  26.   published
  27.     { Published declarations }
  28.     property MultiLine: Boolean read FMultiline write SetMultiline;
  29.     property HoverStyles: TFontStyles read FHoverStyles write SetHoverStyles;
  30.   end;
  31.  
  32. procedure Register;
  33.  
  34. implementation
  35.  
  36. procedure Register;
  37. begin
  38.   RegisterComponents('TDSoft', [TTDSuperButton]);
  39. end;
  40.  
  41. { TTDSuperButton }
  42. procedure TTDSuperButton.CMMOUSEENTER(var Mes: TMessage);
  43. begin
  44.   Font.Style:=FHoverStyles;
  45. end;
  46.  
  47. procedure TTDSuperButton.CMMOUSELEAVE(var Mes: TMessage);
  48. begin
  49.   Font.Style:=Font.Style - [fsBold];
  50. end;
  51.  
  52. procedure TTDSuperButton.CreateParams(var Params: TCreateParams);
  53. begin
  54.   inherited;
  55.   Params.Style:=Params.Style and (not WS_TABSTOP);
  56.   if FMultiLine then Params.Style:=Params.Style or BS_MULTILINE;
  57. end;
  58.  
  59. procedure TTDSuperButton.SetHoverStyles(const Value: TFontStyles);
  60. begin
  61.   FHoverStyles := Value;
  62. end;
  63.  
  64. procedure TTDSuperButton.SetMultiline(const Value: Boolean);
  65. begin
  66.   FMultiline := Value;
  67.   RecreateWnd;
  68. end;
  69.  
  70. procedure TTDSuperButton.WMERASEBKGND(var Mes: TMessage);
  71. begin
  72. end;
  73.  
  74. procedure TTDSuperButton.WMPAINT(var Mes: TMessage);
  75. var
  76.   rgn: HRGN;
  77.   BTNDC: HDC;
  78.   MyCanvas: TCanvas;
  79. begin
  80.   rgn:=CreateEllipticRgn(10,10,Width-10,Height-10);
  81.   SetWindowRgn(Handle,rgn,TRUE);
  82.   BTNDC:=GetWindowDC(Handle);
  83.   MyCanvas:=TCanvas.Create;
  84.   try
  85.     MyCanvas.Handle:=BTNDC;
  86.     with MyCanvas do
  87.     begin
  88.       Brush.Color:=clnone;
  89.       Pen.Color:=clGreen;
  90.  
  91.       Ellipse(10,10,Width-10,Height-10);
  92.     end;
  93.   finally
  94.     FreeAndNil(MyCanvas);
  95.   end;
  96.  
  97. end;
  98.  
  99. end.
  100.