home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 March / Chip_2002-03_cd1.bin / zkuste / delphi / kolekce / d123456 / SIMONS.ZIP / Units / OvalBtn.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-10-11  |  19.4 KB  |  719 lines

  1. unit OvalBtn;
  2.  
  3. { TOvalButton (C)opyright 2000 Version 1.32
  4.   Autor : Simon Reinhardt
  5.   eMail : reinhardt@picsoft.de
  6.   Internet : http://www.picsoft.de
  7.  
  8.   Die Komponente TOvalButton ist eine ovale SpeedButton-Komponente. Sie ist
  9.   abgeleteitet von TGraphicControl und ist eine Weiterentwicklung der Komponente
  10.   TRoundButton von Brendan Rempel, der so nett war, diese als Public Domain
  11.   zu ver÷ffentlichen.
  12.  
  13.   Vielen Dank auch an Marco Lange <marco@marcolange.de> fⁿr die Korrektur
  14.   der OnMouseEnter- und OnMouseLeave-Ereignisse.
  15.  
  16.   Die Komponente TOvalButton ist Public Domain, das Urheberrecht liegt
  17.   aber beim Autor. }
  18.  
  19. interface
  20.  
  21. {$I SRDefine.inc}
  22.  
  23. uses
  24.   {$IFDEF SR_Win32} Windows, {$ELSE} WinTypes, WinProcs, {$ENDIF} Classes,
  25.   Graphics, Controls, SysUtils, Messages;
  26.  
  27. type
  28.   TNumGlyphs = 0..4;
  29.   TButtonLayout = (blGlyphBottom, blGlyphLeft, blGlyphRight, blGlyphTop);
  30.  
  31.   TOvalButton = class(TGraphicControl)
  32.   private
  33.     FColor,
  34.     FColorHighlight,
  35.     FColorShadow:      TColor;
  36.     FDown,IsDown,
  37.     FFlat:             boolean;
  38.     FFont:             TFont;
  39.     FGlyph:            TBitmap;
  40.     FGroupIndex:       integer;
  41.     FLayout:           TButtonLayout;
  42.     FMargin:           integer;
  43.     FNumGlyphs:        TNumGlyphs;
  44.     FSpacing,
  45.     FState:            integer;
  46.     FTransparent:      boolean;
  47.     FTransparentColor: TColor;
  48.  
  49.     FMouseDown,
  50.     FMouseInside:      boolean;
  51.     FOnClick,
  52.     FOnDblClick,
  53.     FOnMouseEnter,
  54.     FOnMouseExit:      TNotifyEvent;
  55.     FOnMouseDown:      TMouseEvent;
  56.     FOnMouseMove:      TMouseMoveEvent;
  57.     FOnMouseUp:        TMouseEvent;
  58.  
  59.     procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
  60.     procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  61.  
  62.   protected
  63.     procedure Paint; override;
  64.     procedure Click; override;
  65.     procedure DblClick; override;
  66.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  67.       override;
  68.     procedure MouseMove(Shift: TShiftState; X, Y: Integer);
  69.       override;
  70.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  71.       override;
  72.  
  73.     function  IsInsideButton(X,Y: Integer): boolean;
  74.  
  75.     procedure SetColor(newColor: TColor);
  76.     procedure SetDown(newValue: boolean);
  77.     procedure SetFlat(newValue: boolean);
  78.     procedure SetFont(newFont: TFont);
  79.     procedure SetGlyph(newGlyph: TBitmap);
  80.     procedure SetLayout(newLayout: TButtonLayout);
  81.     procedure SetMargin(newValue: integer);
  82.     procedure SetNumGlyphs(newNumGlyphs: TNumGlyphs);
  83.     procedure SetSpacing(newValue: integer);
  84.     procedure SetTransparent(newValue: boolean);
  85.     procedure SetTransparentColor(newColor: TColor);
  86.  
  87.     procedure PaintBorder;
  88.     procedure PaintButton;
  89.  
  90.   public
  91.     constructor Create(AOwner: TComponent); override;
  92.     destructor Destroy; override;
  93.  
  94.     procedure CMTextChanged(var msg: TMessage);message CM_TEXTCHANGED;
  95.     procedure CMDialogChar(var Message: TCMDialogChar);message CM_DIALOGCHAR;
  96.  
  97.   published
  98.     {$IFDEF SR_Delphi5_Up}
  99.     property Action;
  100.     property Anchors;
  101.     {$ENDIF}
  102.     property Caption;
  103.     property Color: TColor read FColor write SetColor;
  104.     property Down: boolean read FDown write SetDown;
  105.     property Enabled;
  106.     property Flat: boolean read FFlat write SetFlat;
  107.     property Font: TFont read FFont write SetFont;
  108.     property Glyph: TBitmap read FGlyph write SetGlyph;
  109.     property GroupIndex: integer read FGroupIndex write FGroupIndex;
  110.     property Layout: TButtonLayout read FLayout write SetLayout;
  111.     property Margin: integer read FMargin write SetMargin;
  112.     property NumGlyphs: TNumGlyphs read FNumGlyphs write SetNumGlyphs default 0;
  113.     property ParentFont;
  114.     property ParentShowHint;
  115.     {$IFDEF SR_Delphi3_Up}
  116.     property PopupMenu;
  117.     {$ENDIF}
  118.     property ShowHint;
  119.     property Spacing: integer read FSpacing write SetSpacing;
  120.     property Transparent: boolean read FTransparent write SetTransparent;
  121.     property TransparentColor: TColor read FTransparentColor write SetTransparentColor;
  122.     property Visible;
  123.     property OnClick: TNotifyEvent read FOnClick write FOnClick;
  124.     property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
  125.     property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
  126.     property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
  127.     property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
  128.     property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
  129.     property OnMouseExit: TNotifyEvent read FOnMouseExit  write FOnMouseExit;
  130.   end;
  131.  
  132. procedure Register;
  133.  
  134. implementation
  135.  
  136. {$IFDEF SR_Delphi2_Up}
  137. {$R *.D32}
  138. uses rrColors;
  139. {$ELSE}
  140. {$R *.D16}
  141. {$ENDIF}
  142.  
  143. const
  144.   DefaultWidth  = 100;
  145.   DefaultHeight = 50;
  146.   FHLContrast   = 5;
  147.   FShContrast   = 4;
  148.  
  149. function IsAccellerator(VK: Word; const Str: string): Boolean;
  150. var
  151.   P : Integer;
  152. begin
  153.   P := Pos('&', Str);
  154.   Result := (P <> 0) and (P < Length(Str)) and
  155.     (Upcase(Str[P + 1])=Upcase(Char(VK)));
  156. end;
  157.  
  158. {$IFDEF SR_Delphi1}
  159. function ChangeBrightness(Color:TColor;Percentage:longint):TColor;
  160. var RGBColor       : longint;
  161.     Red,Green,Blue : byte;
  162.     NewR,NewG,NewB : longint;
  163.     Overflow       : longint;
  164. begin
  165.   RGBColor:=ColorToRGB(Color);
  166.   Overflow:=0;
  167.   {Rot}
  168.   Red:=GetRValue(RGBColor);
  169.   NewR:=Red+(Percentage*Red div 100);
  170.   if NewR>255 then begin
  171.     Overflow:=NewR-255;
  172.     NewG:=Overflow;
  173.     NewB:=Overflow;
  174.   end
  175.   else begin
  176.     NewG:=0;
  177.     NewB:=0;
  178.   end;
  179.   {Grⁿn}
  180.   Green:=GetGValue(RGBColor);
  181.   NewG:=NewG+Green+(Percentage*Green div 100);
  182.   if NewG>255 then begin
  183.     Overflow:=NewG-255;
  184.     NewR:=NewR+Overflow;
  185.     NewB:=Overflow;
  186.   end;
  187.   {Blau}
  188.   Blue:=GetBValue(RGBColor);
  189.   NewB:=NewB+Blue+(Percentage*Blue div 100);
  190.   if NewB>255 then begin
  191.     Overflow:=NewB-255;
  192.     if NewG<=255 then
  193.       NewR:=NewR+Overflow;
  194.   end;
  195.   if NewR>255 then
  196.     NewR:=255;
  197.   if NewG>255 then
  198.     NewG:=255;
  199.   if NewB>255 then
  200.     NewB:=255;
  201.   if NewR<0 then
  202.     NewR:=0;
  203.   if NewG<0 then
  204.     NewG:=0;
  205.   if NewB<0 then
  206.     NewB:=0;
  207.   Result:=NewR+(NewG shl 8)+(NewB shl 16);
  208. end;
  209. {$ENDIF}
  210.  
  211. procedure AssignBevelColors(FaceColor:TColor;var HighlightColor,ShadowColor:TColor;HLContrast,ShContrast:integer);
  212. begin
  213.   {$IFDEF SR_Delphi1}
  214.   HighlightColor:=ChangeBrightness(FaceColor,100 div 10*HLContrast);
  215.   ShadowColor:=ChangeBrightness(FaceColor,-100 div 10*ShContrast);
  216.   {$ELSE}
  217.   Get3DColors(FaceColor,HighlightColor,ShadowColor,(10-HLContrast)/10,(10-ShContrast)/10);
  218.   {$ENDIF}
  219. end;
  220.  
  221.  
  222. { Komponente TOvalButton }
  223. constructor TOvalButton.Create(AOwner: TComponent);
  224. begin
  225.   inherited Create(AOwner);
  226.  
  227.   {Vorgabewerte setzen}
  228.   FColor:=clBtnFace;
  229.   AssignBevelColors(FColor,FColorHighlight,FColorShadow,FHLContrast,FShContrast);
  230.   FDown:=false;
  231.   FFlat:=false;
  232.   FFont:=TFont.Create;
  233.   FGlyph:=TBitmap.Create;
  234.   FGroupIndex:=0;
  235.   FNumGlyphs:=0;
  236.   FSpacing :=4;
  237.   FState:=1;
  238.   FTransparent:=false;
  239.   Height:=DefaultHeight;
  240.   Width:=DefaultWidth;
  241.  
  242.   FMouseInside:=False;
  243.   FMouseDown:=False;
  244. end;
  245.  
  246. destructor  TOvalButton.Destroy;
  247. begin
  248.   FFont.Free;
  249.   FGlyph.Free;
  250.   inherited Destroy;
  251. end;
  252.  
  253. procedure TOvalButton.SetColor(newColor: TColor);
  254. begin
  255.   if FColor<>newColor then begin
  256.     FColor:=newColor;
  257.     AssignBevelColors(FColor,FColorHighlight,FColorShadow,FHLContrast,FShContrast);
  258.     Invalidate;
  259.   end;
  260. end;
  261.  
  262. procedure TOvalButton.SetDown(newValue: boolean);
  263. begin
  264.   if FDown<>newValue then begin
  265.     FDown:=newValue;
  266.     if FDown then
  267.       FState:=-1
  268.     else begin
  269.       if FFlat then
  270.         FState:=0
  271.       else
  272.         FState:=1;
  273.     end;
  274.     Invalidate;
  275.   end;
  276. end;
  277.  
  278. procedure TOvalButton.SetFlat(newValue: boolean);
  279. begin
  280.   if FFlat<>newValue then begin
  281.     FFlat:=newValue;
  282.     if FFlat then
  283.       FState:=0
  284.     else
  285.       FState:=1;
  286.     Invalidate;
  287.   end;
  288. end;
  289.  
  290. procedure TOvalButton.SetFont(newFont: TFont);
  291. begin
  292.   if FFont<>newFont then begin
  293.     FFont.Assign(newFont);
  294.     Invalidate;
  295.   end;
  296. end;
  297.  
  298. procedure TOvalButton.SetGlyph(newGlyph: TBitmap);
  299. begin
  300.   if(Assigned(FGlyph)) then begin
  301.     FGlyph.Assign(newGlyph);
  302.     FTransparentColor:=FGlyph.Canvas.Pixels[0,FGlyph.Height-1];
  303.  
  304.     if (csDesigning in ComponentState) then begin
  305.       { Glyph 1: Normal, 2: Disabled, 3: Down;
  306.         Mu▀ die Ausma▀e (Height * NumGlyphs) = Width  haben}
  307.       if (newGlyph.width mod newGlyph.height=0) then
  308.         FNumGlyphs:=newGlyph.width div newGlyph.height
  309.       else
  310.         FNumGlyphs:=1;
  311.     end;
  312.  
  313.     Invalidate;
  314.   end;
  315. end;
  316.  
  317. procedure TOvalButton.SetLayout(newLayout: TButtonLayout);
  318. begin
  319.   if FLayout<>newLayout then begin
  320.     FLayout:=newLayout;
  321.     Invalidate;
  322.   end;
  323. end;
  324.  
  325. procedure TOvalButton.SetMargin(newValue: integer);
  326. begin
  327.   if FMargin<>newValue then begin
  328.     FMargin:=newValue;
  329.     Invalidate;
  330.   end;
  331. end;
  332.  
  333. procedure TOvalButton.SetNumGlyphs(newNumGlyphs: TNumGlyphs);
  334. begin
  335.   if FNumGlyphs<>newNumGlyphs then begin
  336.     FNumGlyphs:=newNumGlyphs;
  337.     Invalidate;
  338.   end;
  339. end;
  340.  
  341. procedure TOvalButton.SetSpacing(newValue: integer);
  342. begin
  343.   if FSpacing<>newValue then begin
  344.     FSpacing:=newValue;
  345.     Invalidate;
  346.   end;
  347. end;
  348.  
  349. procedure TOvalButton.SetTransparent(newValue: boolean);
  350. begin
  351.   if FTransparent<>newValue then begin
  352.     FTransparent:=newValue;
  353.     Invalidate;
  354.   end;
  355. end;
  356.  
  357. procedure TOvalButton.SetTransparentColor(newColor: TColor);
  358. begin
  359.   if FTransparentColor<>newColor then begin
  360.     FTransparentColor:=newColor;
  361.     Invalidate;
  362.   end;
  363. end;
  364.  
  365. function TOvalButton.IsInsideButton(X,Y: Integer):boolean;
  366. var BtnEllipse : HRgn;
  367. begin
  368.   { Ist die Maus ⁿber der Button-Ellipse? }
  369.   BtnEllipse:=CreateEllipticRgn(0,0,Width,Height);
  370.   Result:=PtInRegion(BtnEllipse,X,Y);
  371.   DeleteObject(BtnEllipse);
  372. end;
  373.  
  374. procedure TOvalButton.Paint;
  375. begin
  376.   Canvas.Font.Assign(Font);
  377.   with Canvas do begin
  378.      if FTransparent then
  379.        brush.Style:=bsClear
  380.      else begin
  381.        Brush.Style:=bsSolid;
  382.        brush.color:=Color;
  383.      end;
  384.      if FFlat then
  385.        pen.Style:=psClear
  386.      else begin
  387.        pen.Style:=psSolid;
  388.        pen.color:=clBlack;
  389.      end;
  390.      { Button mit Farbe fⁿllen, schwarzen Rand zeichnen }
  391.      Pen.Width:=1;
  392.      Ellipse(0,0,width-1,height-1);
  393.   end;
  394.  
  395.   { Den Rest zeichnen }
  396.   PaintButton;
  397. end;
  398.  
  399. procedure TOvalButton.PaintBorder;
  400. begin
  401.   with Canvas do begin
  402.     pen.style:=psSolid;
  403.     { linke obere Ecke zeichnen }
  404.     if FState=-1 then  {down}
  405.       pen.color:=FColorShadow;
  406.     if FState=1 then  {up}
  407.       pen.color:=FColorHighlight;
  408.     if FState=0 then  {flat}
  409.       pen.style:=psClear;
  410.     Arc(1,1,width-2,height-2,width div 5 * 4,height div 5,width div 5,height div 5 * 4);
  411.     { rechte untere Ecke zeichnen }
  412.     if FState=-1 then  {down}
  413.       pen.color:=FColorHighlight;
  414.     if FState=1 then   {up}
  415.       pen.color:=FColorShadow;
  416.     Arc(1,1,width-2,height-2,width div 5,height div 5 * 4,width div 5 * 4,height div 5);
  417.     pen.style:=psSolid;
  418.   end;
  419. end;
  420.  
  421. procedure TOvalButton.PaintButton;
  422. var
  423.   Dest,
  424.   Source,
  425.   TextR     : TRect;
  426.   outWidth,
  427.   outHeight,
  428.   TextLeft,
  429.   TextTop   : integer;
  430.   outText   : array [0..79] of char;
  431. begin
  432.   { Glyph zeichnen ? }
  433.   if Assigned(FGlyph) then begin
  434.      with Source do begin
  435.        { Source-Rechteck ermitteln }
  436.        Left:=0;
  437.        Right:=FGlyph.Width;
  438.        Top:=0;
  439.        Bottom:=FGlyph.Height;
  440.        if FNumGlyphs>0 then
  441.          Right:=Right div FNumGlyphs;
  442.      end;
  443.   end;
  444.  
  445.   PaintBorder;
  446.  
  447.   with Canvas do begin
  448.     { Glyph anzeigen }
  449.     outWidth:=0;
  450.     outHeight:=0;
  451.     if Assigned(FGlyph) and (FNumGlyphs>0) then begin
  452.       if(Not Enabled and (FNumGlyphs>1)) then begin
  453.         { disabled button }
  454.         Source.Left:=FGlyph.width div FNumGlyphs;
  455.         Source.Right:=Source.Left shl 1;
  456.       end;
  457.       { Gr÷▀e des Destination-Rechtecks }
  458.       outWidth:=Source.Right-Source.Left;
  459.       outHeight:=Source.Bottom-Source.Top;
  460.       { Glyph-Position ermitteln }
  461.       if (Caption='') or (FLayout=blGlyphTop) or (FLayout=blGlyphBottom) then begin
  462.         Dest.Left:=((Width-outWidth) shr 1);
  463.         Dest.Right:=((Width-outWidth) shr 1)+outWidth;
  464.       end;
  465.       if (Caption<>'') and (FLayout=blGlyphLeft) then begin
  466.         Dest.Left:=((Width-(outWidth+FSpacing+TextWidth(Caption))) shr 1)-FMargin;
  467.         Dest.Right:=Dest.Left+outWidth;
  468.       end;
  469.       if (Caption<>'') and (FLayout=blGlyphRight) then begin
  470.         Dest.Left:=((Width+(outWidth+FSpacing+TextWidth(Caption))) shr 1)-outWidth+FMargin;
  471.         Dest.Right:=Dest.Left+outWidth;
  472.       end;
  473.       if (Caption='') or (FLayout=blGlyphLeft) or (FLayout=blGlyphRight) then begin
  474.         Dest.Top:=((Height-outHeight) shr 1);
  475.         Dest.Bottom:=((Height-outHeight) shr 1)+outHeight;
  476.       end;
  477.       if (Caption<>'') and (FLayout=blGlyphTop) then begin
  478.         Dest.Top:=((Height-(outHeight+FSpacing+TextHeight(Caption))) shr 1)-FMargin;
  479.         Dest.Bottom:=Dest.Top+outHeight;
  480.       end;
  481.       if (Caption<>'') and (FLayout=blGlyphBottom) then begin
  482.         Dest.Top:=((Height+(outHeight+FSpacing+TextHeight(Caption))) shr 1)-outHeight+FMargin;
  483.         Dest.Bottom:=Dest.Top+outHeight;
  484.       end;
  485.       if FTransparent then
  486.         Pen.Style:=psClear
  487.       else begin
  488.         Pen.Style:=psSolid;
  489.         Pen.Color:=Color;
  490.       end;
  491.       if FState=-1 then begin {down}
  492.         { Glyph um 1 Pixel nach rechts unten verschieben }
  493.         Inc(Dest.Left);
  494.         Inc(Dest.Right);
  495.         Inc(Dest.Top);
  496.         Inc(Dest.Bottom);
  497.         { verbleibende Up-Reste l÷schen }
  498.         MoveTo(Dest.Left-1,Dest.Bottom);
  499.         LineTo(Dest.Left-1,Dest.Top-1);
  500.         LineTo(Dest.Right,Dest.Top-1);
  501.       end
  502.       else begin
  503.         { verbleibende Down-Reste l÷schen }
  504.         MoveTo(Dest.Right,Dest.Top);
  505.         LineTo(Dest.Right,Dest.Bottom);
  506.         LineTo(Dest.Left,Dest.Bottom);
  507.       end;
  508.       Pen.Style := psSolid;
  509.       if ((FState=-1) and (FNumGlyphs>2)) then begin
  510.         { Glyph fⁿr gedrⁿckten Zustand bestimmen }
  511.         Source.Left:=FGlyph.width div FNumGlyphs * 2;
  512.         Source.Right:=FGlyph.width div FNumGlyphs * 3;
  513.       end;
  514.       if FTransparent then
  515.         Brush.Style:=bsClear
  516.       else begin
  517.         Brush.Style:=bsSolid;
  518.         Brush.Color:=Color;
  519.       end;
  520.  
  521.       { Glyph zeichnen }
  522.       BrushCopy(Dest, FGlyph, Source, FTransparentColor);
  523.     end;
  524.  
  525.     { Caption zeichnen }
  526.     if Caption<>'' then begin
  527.       {Position ermitteln}
  528.       TextLeft:=(width-TextWidth(Caption)) shr 1;
  529.       if Assigned(FGlyph) and (FNumGlyphs>0) and (FLayout=blGlyphRight) then
  530.         TextLeft:=Dest.Left-TextWidth(Caption)-FSpacing;
  531.       if Assigned(FGlyph) and (FNumGlyphs>0) and (FLayout=blGlyphLeft) then
  532.         TextLeft:=Dest.Left+outWidth+FSpacing;
  533.       TextTop:=(height-TextHeight(Caption)) shr 1;
  534.       if Assigned(FGlyph) and (FNumGlyphs>0) and (FLayout=blGlyphTop) then
  535.         TextTop:=Dest.Top+outHeight+FSpacing;
  536.       if Assigned(FGlyph) and (FNumGlyphs>0) and (FLayout=blGlyphBottom) then
  537.         TextTop:=Dest.Top-TextHeight(Caption)-FSpacing;
  538.       if FState=-1 then begin
  539.         inc(TextTop);
  540.         inc(TextLeft);
  541.       end;
  542.       {Text ausgeben}
  543.       if FTransparent then
  544.         Brush.Style:=bsClear
  545.       else begin
  546.         Brush.Style:=bsSolid;
  547.         Brush.Color:=Color;
  548.       end;
  549.       if FState=-1 then
  550.         { verbleibende Up-Reste l÷schen }
  551.         FillRect(Rect(TextLeft,
  552.                       TextTop,
  553.                       TextLeft+TextWidth(Caption),
  554.                       TextTop+TextHeight(Caption)))
  555.       else
  556.         { verbleibende Down-Reste l÷schen }
  557.         FillRect(Rect(TextLeft+1,
  558.                       TextTop+1,
  559.                       TextLeft+1+TextWidth(Caption),
  560.                       TextTop+1+TextHeight(Caption)));
  561.       TextR:=Rect(TextLeft,
  562.                   TextTop,
  563.                   TextLeft+TextWidth(Caption),
  564.                   TextTop+TextHeight(Caption));
  565.       StrPCopy(outText,Caption);
  566.       DrawText(Handle,
  567.                outText,
  568.                length(Caption),
  569.                TextR,
  570.                DT_SingleLine);
  571.     end;
  572.   end;
  573. end;
  574.  
  575. procedure TOvalButton.CMDialogChar(var Message: TCMDialogChar);
  576. begin
  577.   with Message do begin
  578.     if IsAccellerator(CharCode, Caption) then begin
  579.       if Enabled then
  580.         Click;
  581.       Result:=1;
  582.     end
  583.     else
  584.       inherited;
  585.   end;
  586. end;
  587.  
  588. procedure TOvalButton.Click;
  589. begin
  590.   if Enabled and FMouseInside then
  591.     if Assigned(FOnClick) then
  592.       FOnClick(Self);
  593. end;
  594.  
  595. procedure TOvalButton.DblClick;
  596. begin
  597.   if Enabled and FMouseInside then
  598.     if Assigned(FOnDblClick) then
  599.       FOnDblClick(Self);
  600. end;
  601.  
  602. procedure TOvalButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  603. begin
  604.   if (Enabled and IsInsideButton(X,Y)) then begin
  605.     IsDown:=FDown;
  606.     { Im gedrⁿckten Zustand neu zeichnen }
  607.     FDown:=true;
  608.     FState:=-1;
  609.     if FTransparent then
  610.       Invalidate
  611.     else
  612.       PaintButton;
  613.     if Assigned(FOnMouseDown) then
  614.       FOnMouseDown(Self, Button, Shift, X, Y);
  615.   end;
  616.   FMouseDown:= True;
  617. end;
  618.  
  619. procedure TOvalButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  620. begin
  621.   if (Enabled and IsInsideButton(X,Y)) then begin
  622.     { Im ungedrⁿckten Zustand neu zeichnen }
  623.     if GroupIndex=0 then begin
  624.       FDown:=false;
  625.       FState:=1;
  626.       if FTransparent then
  627.         Invalidate
  628.       else
  629.         PaintButton;
  630.     end
  631.     else
  632.       SetDown(not IsDown);
  633.     { OnClick-Ereignis abfeuern }
  634.     if Assigned(FOnMouseUp) then
  635.       FOnMouseUp(Self, Button, Shift, X, Y);
  636.   end;
  637.   FMouseDown:= False;
  638. end;
  639.  
  640. procedure TOvalButton.MouseMove(Shift: TShiftState; X, Y: Integer);
  641. begin
  642.   if FMouseDown then begin
  643.     if not IsInsideButton(X,Y) then begin
  644.       { Button.Down aufheben, falls Maus Button verlΣsst }
  645.       if (FState=-1) and (GroupIndex=0) and FMouseInside then begin
  646.         FDown:=false;
  647.         FState:=1;
  648.         PaintBorder;
  649.       end;
  650.       FMouseInside:=false;
  651.     end
  652.     else begin
  653.       { Button.Down setzen, falls Maus ⁿber Button }
  654.       if (FState=1) and (GroupIndex=0) then begin
  655.         FMouseInside:=true;
  656.         FDown:=true;
  657.         FState:=-1;
  658.         PaintBorder;
  659.       end;
  660.     end;
  661.   end
  662.   else begin
  663.     if FFlat and not FDown then begin
  664.       if not IsInsideButton(X,Y) then begin
  665.         { Button flach }
  666.         if FMouseInside then begin
  667.           FMouseInside:=false;
  668.           FState:=0;
  669.           Invalidate;
  670.         end;
  671.       end
  672.       else begin
  673.         { Button erhaben }
  674.         FMouseInside:=true;
  675.         FState:=1;
  676.         PaintBorder;
  677.       end;
  678.     end
  679.     else
  680.       FMouseInside:=IsInsideButton(X,Y);
  681.   end;
  682.   if FMouseInside then
  683.     if Assigned(FOnMouseMove) then
  684.       FOnMouseMove(Self, Shift, X, Y);
  685. end;
  686.  
  687. procedure TOvalButton.CMTextChanged(var msg: TMessage);
  688. begin
  689.   Invalidate;
  690. end;
  691.  
  692. procedure TOvalButton.CMMouseEnter(var Message: TMessage);
  693. begin
  694.   inherited;
  695.   if assigned(FOnMouseEnter) then
  696.     FOnMouseEnter(self);
  697. end;
  698.  
  699. procedure TOvalButton.CMMouseLeave(var Message: TMessage);
  700. begin
  701.   inherited;
  702.   if FMouseInside and Enabled then begin
  703.     FMouseInside:=False;
  704.     if FFlat and not FDown then begin
  705.       FState:=0;
  706.       Invalidate;
  707.     end;
  708.   end;
  709.   if assigned(FOnMouseExit) then
  710.     FOnMouseExit(Self);
  711. end;
  712.  
  713. procedure Register;
  714. begin
  715.   RegisterComponents('Simon',[TOvalButton]);
  716. end;
  717.  
  718. end.
  719.