home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 March / Chip_2002-03_cd1.bin / zkuste / delphi / kolekce / d123456 / SIMONS.ZIP / Units / SRColBtn.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-10-12  |  27.7 KB  |  949 lines
  1. unit SRColBtn;
  2.  
  3. { TSRColorButton (C)opyright 2000 Version 1.30
  4.   Autor : Simon Reinhardt
  5.   eMail : reinhardt@picsoft.de
  6.   Internet : http://www.picsoft.de
  7.  
  8.   Diese Komponente ist eine TSpeedButton-Σhnliche Button-Komponente,
  9.   die eine Color-Eigenschaft fⁿr farbige Buttons bietet. Au▀erdem
  10.   kann ein Farbverlauf auf die Button-OberflΣche gezeichnet werden
  11.   und es gibt eine per Timer gesteuerte automatische Click-Wiederholung.
  12.  
  13.   Die Komponente ist abgeleitet von TGraphicControl und sie ist Public
  14.   Domain, das Urheberrecht liegt aber beim Autor.
  15.  
  16.   Vielen Dank an Markus Pinl fⁿr die Fehlerkorrektur und die Beisteuerung
  17.   der BorderColor-Eigenschaft und an Robert Rossmair fⁿr die rrColors-Unit! }
  18.  
  19. interface
  20.  
  21. {$I SRDefine.inc}
  22.  
  23. uses
  24.   {$IFDEF SR_Win32} Windows, {$ELSE} WinTypes, WinProcs, {$ENDIF} Classes,
  25.   Graphics, Controls, ExtCtrls, SysUtils, {$IFNDEF SR_Delphi3_Up} Menus,{$ENDIF}
  26.   Messages;
  27.  
  28.  
  29. const
  30.   InitRepeatPause = 400;  { pause before repeat timer (ms) }
  31.   RepeatPause     = 100;  { pause before hint window displays (ms)}
  32.  
  33. type
  34.   TBorderStyle = (bsFlat, bsNormal, bsSingle);
  35.   TButtonLayout = (blGlyphBottom, blGlyphLeft, blGlyphRight, blGlyphTop);
  36.   TContrast = 0..9;
  37.   TGradDirection = (gdDownRight, gdUpLeft);
  38.   TGradientStyle = (gsNone, gsHorizontal, gsPyramid, gsVertical);
  39.   TNumGlyphs = 0..4;
  40.  
  41.  
  42.   TSRColorButton = class(TGraphicControl)
  43.   private
  44.     FAllowAllUp,
  45.     FAllowTimer:        boolean;
  46.     FBC:                array[0..255] of longint;
  47.     FBevelWidth:        integer;
  48.     FBorderColor:       TColor;
  49.     FBorderStyle:       TBorderStyle;
  50.     FChangeDirection:   boolean;
  51.     FColor,
  52.     FColorHighlight,
  53.     FColorShadow:       TColor;
  54.     FContrastHighlight,
  55.     FContrastShadow:    TContrast;
  56.     FGradientDirection: TGradDirection;
  57.     FGrouped:           boolean;
  58.     FGroupIndex:        integer;
  59.     FDown:              boolean;
  60.     FGlyph:             TBitmap;
  61.     FGradientStyle:     TGradientStyle;
  62.     FLayout:            TButtonLayout;
  63.     FMargin:            integer;
  64.     FNumGlyphs:         TNumGlyphs;
  65.     FRepeatTimer:       TTimer;
  66.     FSpacing:           integer;
  67.     FTimerDelay,
  68.     FTimerInterval:     word;
  69.     FTopMargin:         integer;
  70.  
  71.     FMouseDown:         boolean;
  72.     FOnClick:           TNotifyEvent;
  73.  
  74.     procedure CMDialogChar(var Message: TCMDialogChar);message CM_DIALOGCHAR;
  75.     procedure CMEnabledChanged(var Message:TMessage); message CM_ENABLEDCHANGED;
  76.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  77.     procedure CMTextChanged(var msg: TMessage);message CM_TEXTCHANGED;
  78.     procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_EraseBkgnd;
  79.  
  80.   protected
  81.     procedure DrawBorder;
  82.     procedure DrawGradient;
  83.     procedure LoadColors;
  84.     procedure Paint;  override;
  85.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  86.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  87.     procedure SetAllowAllUp(newValue: boolean);
  88.     procedure SetBevelWidth(newValue: integer);
  89.     procedure SetBorderColor(newColor: TColor);
  90.     procedure SetBorderStyle(newValue: TBorderStyle);
  91.     procedure SetChangeDirection(newValue: boolean);
  92.     procedure SetColor(newColor: TColor);
  93.     procedure SetContrastHighlight(newValue: TContrast);
  94.     procedure SetContrastShadow(newValue: TContrast);
  95.     procedure SetDown(newValue: boolean);
  96.     procedure SetGlyph(newGlyph: TBitmap);
  97.     procedure SetGradientDirection(newValue: TGradDirection);
  98.     procedure SetGradientStyle(newValue: TGradientStyle);
  99.     procedure SetLayout(newValue: TButtonLayout);
  100.     procedure SetMargin(newValue: integer);
  101.     procedure SetNumGlyphs(newNumGlyphs: TNumGlyphs);
  102.     procedure SetSpacing(newValue: integer);
  103.     procedure SetTopMargin(newValue: integer);
  104.     procedure TimerExpired(Sender: TObject);
  105.     procedure UncheckGroupButtons(AIndex: integer);
  106.  
  107.   public
  108.     constructor Create(AOwner: TComponent); override;
  109.     destructor Destroy; override;
  110.     procedure Loaded; override;
  111.  
  112.   published
  113.     {$IFDEF SR_Delphi5_Up}
  114.     property Action;
  115.     {$ENDIF}
  116.     property AllowAllUp: boolean read FAllowAllUp write SetAllowAllUp;
  117.     property AllowTimer: boolean read FAllowTimer write FAllowTimer;
  118.     {$IFDEF SR_Delphi5_Up}
  119.     property Anchors;
  120.     {$ENDIF}
  121.     property BevelWidth: integer read FBevelWidth write SetBevelWidth;
  122.     property BorderColor: TColor read FBorderColor write SetBorderColor;
  123.     property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle;
  124.     property Caption;
  125.     property ChangeDirection: boolean read FChangeDirection write FChangeDirection;
  126.     property Color: TColor read FColor write SetColor;
  127.     property ContrastHighlight: TContrast read FContrastHighlight write SetContrastHighlight;
  128.     property ContrastShadow: TContrast read FContrastShadow write SetContrastShadow;
  129.     property Down: boolean read FDown write SetDown;
  130.     property Enabled;
  131.     property Font;
  132.     property Glyph: TBitmap read FGlyph write SetGlyph;
  133.     property GradientDirection: TGradDirection read FGradientDirection write SetGradientDirection;
  134.     property GradientStyle: TGradientStyle read FGradientStyle write SetGradientStyle;
  135.     property Grouped: boolean read FGrouped write FGrouped;
  136.     property GroupIndex: integer read FGroupIndex write FGroupIndex;
  137.     property Layout: TButtonLayout read FLayout write SetLayout;
  138.     property Margin: integer read FMargin write SetMargin;
  139.     property NumGlyphs: TNumGlyphs read FNumGlyphs write SetNumGlyphs default 0;
  140.     property ParentFont;
  141.     property ParentShowHint;
  142.     property PopupMenu;
  143.     property ShowHint;
  144.     property Spacing: integer read FSpacing write SetSpacing;
  145.     property TimerDelay: word read FTimerDelay write FTimerDelay;
  146.     property TimerInterval: word read FTimerInterval write FTimerInterval;
  147.     property TopMargin: integer read FTopMargin write SetTopMargin;
  148.     property Visible;
  149.     property OnClick;
  150.     property OnDblClick;
  151.     property OnMouseDown;
  152.     property OnMouseMove;
  153.     property OnMouseUp;
  154.   end;
  155.  
  156. procedure Register;
  157.  
  158. implementation
  159.  
  160. {$IFDEF SR_Delphi2_Up}
  161. {$R *.D32}
  162. uses rrColors;
  163. {$ELSE}
  164. {$R *.D16}
  165. {$ENDIF}
  166.  
  167. const
  168.   DefaultWidth  = 75;
  169.   DefaultHeight = 25;
  170.  
  171. function IsAccellerator(VK: Word; const Str: string): Boolean;
  172. var
  173.   P : Integer;
  174. begin
  175.   P := Pos('&', Str);
  176.   Result := (P <> 0) and (P < Length(Str)) and
  177.     (Upcase(Str[P + 1])=Upcase(Char(VK)));
  178. end;
  179.  
  180. {$IFDEF SR_Delphi1}
  181. function ChangeBrightness(Color:TColor;Percentage:longint):TColor;
  182. var RGBColor       : longint;
  183.     Red,Green,Blue : byte;
  184.     NewR,NewG,NewB : longint;
  185.     Overflow       : longint;
  186. begin
  187.   RGBColor:=ColorToRGB(Color);
  188.   Overflow:=0;
  189.   {Rot}
  190.   Red:=GetRValue(RGBColor);
  191.   NewR:=Red+(Percentage*Red div 100);
  192.   if NewR>255 then begin
  193.     Overflow:=NewR-255;
  194.     NewG:=Overflow;
  195.     NewB:=Overflow;
  196.   end
  197.   else begin
  198.     NewG:=0;
  199.     NewB:=0;
  200.   end;
  201.   {Grⁿn}
  202.   Green:=GetGValue(RGBColor);
  203.   NewG:=NewG+Green+(Percentage*Green div 100);
  204.   if NewG>255 then begin
  205.     Overflow:=NewG-255;
  206.     NewR:=NewR+Overflow;
  207.     NewB:=Overflow;
  208.   end;
  209.   {Blau}
  210.   Blue:=GetBValue(RGBColor);
  211.   NewB:=NewB+Blue+(Percentage*Blue div 100);
  212.   if NewB>255 then begin
  213.     Overflow:=NewB-255;
  214.     if NewG<=255 then
  215.       NewR:=NewR+Overflow;
  216.   end;
  217.   if NewR>255 then
  218.     NewR:=255;
  219.   if NewG>255 then
  220.     NewG:=255;
  221.   if NewB>255 then
  222.     NewB:=255;
  223.   if NewR<0 then
  224.     NewR:=0;
  225.   if NewG<0 then
  226.     NewG:=0;
  227.   if NewB<0 then
  228.     NewB:=0;
  229.   Result:=NewR+(NewG shl 8)+(NewB shl 16);
  230. end;
  231. {$ENDIF}
  232.  
  233. procedure AssignBevelColors(FaceColor:TColor;var HighlightColor,ShadowColor:TColor;HLContrast,ShContrast:integer);
  234. begin
  235.   {$IFDEF SR_Delphi1}
  236.   HighlightColor:=ChangeBrightness(FaceColor,100 div 10*HLContrast);
  237.   ShadowColor:=ChangeBrightness(FaceColor,-100 div 10*ShContrast);
  238.   {$ELSE}
  239.   Get3DColors(FaceColor,HighlightColor,ShadowColor,(10-HLContrast)/10,(10-ShContrast)/10);
  240.   {$ENDIF}
  241. end;
  242.  
  243.  
  244. { Komponente SRColorButton }
  245. constructor TSRColorButton.Create(AOwner: TComponent);
  246. begin
  247.   inherited Create(AOwner);
  248.  
  249.   LoadColors;
  250.   { Vorgabewerte setzen }
  251.   FAllowAllUp:=false;
  252.   FBevelWidth:=1;
  253.   FBorderStyle:=bsNormal;
  254.   FColor:=clBtnFace;
  255.   FContrastHighlight:=5;
  256.   FContrastShadow:=6;
  257.   AssignBevelColors(FColor,FColorHighlight,FColorShadow,FContrastHighlight,FContrastShadow);
  258.   FGradientDirection:=gdDownRight;
  259.   FDown:=false;
  260.   FGlyph:=TBitmap.Create;
  261.   FGradientStyle:=gsNone;
  262.   FGrouped:=false;
  263.   FGroupIndex:=0;
  264.   FLayout:=blGlyphLeft;
  265.   FMargin:=1;
  266.   FNumGlyphs:=0;
  267.   FSpacing:=1;
  268.   FTopMargin:=0;
  269.   TimerDelay:=InitRepeatPause;
  270.   TimerInterval:=RepeatPause;
  271.   Height:=25;
  272.   Width:=75;
  273.  
  274.   FMouseDown:=False;
  275. end;
  276.  
  277. destructor TSRColorButton.Destroy;
  278. begin
  279.   FGlyph.Free;
  280.   if FRepeatTimer <> nil then
  281.     FRepeatTimer.Free;
  282.   inherited Destroy;
  283. end;
  284.  
  285. procedure TSRColorButton.CMDialogChar(var Message: TCMDialogChar);
  286. begin
  287.   with Message do begin
  288.     if IsAccellerator(CharCode, Caption) then begin
  289.       if Enabled then
  290.         Click;
  291.       Result := 1;
  292.     end
  293.     else
  294.       inherited;
  295.   end;
  296. end;
  297.  
  298. procedure TSRColorButton.CMEnabledChanged(var Message:TMessage);
  299. begin
  300.   inherited;
  301.   Invalidate;
  302. end;
  303.  
  304. procedure TSRColorButton.CMFontChanged(var Message: TMessage);
  305. begin
  306.   inherited;
  307.   Invalidate;
  308. end;
  309.  
  310. procedure TSRColorButton.CMTextChanged(var msg: TMessage);
  311. begin
  312.   inherited;
  313.   Invalidate;
  314. end;
  315.  
  316. procedure TSRColorButton.DrawBorder;
  317. var i      : integer;
  318.     Dest,
  319.     Source : TRect;
  320. begin
  321.   Dest:=GetClientRect;
  322.   with Canvas do begin
  323.     Brush.Style:=bsSolid;
  324.     Pen.Style:=psSolid;
  325.     Pen.Width:=1;
  326.     if FBorderStyle=bsSingle then begin
  327.       Brush.Color:=FBorderColor;
  328.       FrameRect(Dest);
  329.       InflateRect(Dest,-1,-1);
  330.     end;
  331.     if FBorderStyle=bsNormal then begin
  332.       if FDown then
  333.         Pen.Color:=FBorderColor
  334.       else
  335.         Pen.Color:=FColorHighlight;
  336.       MoveTo(Dest.Left, Dest.Bottom-1);
  337.       LineTo(Dest.Left, Dest.Top);
  338.       LineTo(Dest.Right-1, Dest.Top);
  339.       if FDown then
  340.         Pen.Color:=FColorHighlight
  341.       else
  342.         Pen.Color:=FBorderColor;
  343.       MoveTo(Dest.Left, Dest.Bottom-1);
  344.       LineTo(Dest.Right-1, Dest.Bottom-1);
  345.       LineTo(Dest.Right-1, Dest.Top);
  346.       InflateRect(Dest,-1,-1);
  347.     end;
  348.  
  349.     { links + oben }
  350.     if FDown then
  351.       Pen.Color:=FColorShadow
  352.     else
  353.       Pen.Color:=FColorHighlight;
  354.     for i:=0 to FBevelWidth-1 do begin
  355.       MoveTo(Dest.Right-i-1, Dest.Top+i);
  356.       LineTo(Dest.Left+i, Dest.Top+i);
  357.       LineTo(Dest.Left+i, Dest.Bottom-i-1);
  358.     end;
  359.  
  360.     { rechts + unten }
  361.     if FDown then
  362.       Pen.Color:=FColorHighlight
  363.     else
  364.       Pen.Color:=FColorShadow;
  365.     for i:=0 to FBevelWidth-1 do begin
  366.       MoveTo(Dest.Right-i-1, Dest.Top+i);
  367.       LineTo(Dest.Right-i-1, Dest.Bottom-i-1);
  368.       LineTo(Dest.Left+i, Dest.Bottom-i-1);
  369.     end;
  370.  
  371.     if FDown then begin
  372.       { Source mu▀ links oben beginnen, rechts+unten 1 Pixel Rand }
  373.       Source.Left:=Dest.Left+FBevelWidth;
  374.       Source.Top:=Dest.Top+FBevelWidth;
  375.       Source.Right:=Dest.Right-FBevelWidth-1;
  376.       Source.Bottom:=Dest.Bottom-FBevelWidth-1;
  377.       i:=1;
  378.     end
  379.     else begin
  380.       { Source mu▀ rechts unten anliegen, links+oben 1 Pixel Rand }
  381.       Source.Left:=Dest.Left+FBevelWidth+1;
  382.       Source.Top:=Dest.Top+FBevelWidth+1;
  383.       Source.Right:=Dest.Right-FBevelWidth;
  384.       Source.Bottom:=Dest.Bottom-FBevelWidth;
  385.       i:=-1;
  386.     end;
  387.     { Entsprechende Verschiebung }
  388.     Dest.Right:=Source.Right+i;
  389.     Dest.Left:=Source.Left+i;
  390.     Dest.Top:=Source.Top+i;
  391.     Dest.Bottom:=Source.Bottom+i;
  392.  
  393.     Self.Canvas.CopyRect(Dest, Self.Canvas, Source);
  394.   end;
  395. end;
  396.  
  397. procedure TSRColorButton.DrawGradient;
  398. var
  399.   OutRect,
  400.   TempRect   : TRect;
  401.   TempStepV  : Single;
  402.   TempStepH  : Single;
  403.   ColorCode,
  404.   TempLeft,
  405.   TempTop,
  406.   OutWidth,
  407.   OutHeight,
  408.   TempHeight,
  409.   TempWidth,
  410.   ECount,i   : integer;
  411.   FlipDir    : boolean;
  412. begin
  413.   OutRect:=GetClientRect;
  414.   OutWidth:=OutRect.Right-OutRect.Left;
  415.   OutHeight:=OutRect.Bottom-OutRect.Top;
  416.   FlipDir:=FChangeDirection and FDown;
  417.   if (FGradientStyle=gsHorizontal) or (FGradientStyle=gsVertical) then begin
  418.     if FGradientStyle=gsVertical then begin
  419.       TempStepH:=1;
  420.       TempStepV:=OutHeight/255;
  421.       TempHeight:=Trunc(TempStepV+1);
  422.       TempWidth:=1;
  423.     end
  424.     else begin
  425.       TempStepH:=OutWidth/255;
  426.       TempStepV:=1;
  427.       TempHeight:=1;
  428.       TempWidth:=Trunc(TempStepH+1);
  429.     end;
  430.     with Canvas do begin
  431.       TempTop:=OutRect.Top;
  432.       TempLeft:=OutRect.Left;
  433.       TempRect:=OutRect;
  434.       { Geradlinigen Verlauf zeichnen }
  435.       Brush.Style:=bsSolid;
  436.       for ColorCode:=0 to 255 do begin
  437.         if FlipDir then
  438.           Brush.Color:=FBC[255-ColorCode]
  439.         else
  440.           Brush.Color:=FBC[ColorCode];
  441.         if FGradientStyle=gsVertical then begin
  442.           TempRect.Top:=TempTop;
  443.           TempRect.Bottom:=TempTop+TempHeight;
  444.         end
  445.         else begin
  446.           TempRect.Left:=TempLeft;
  447.           TempRect.Right:=TempLeft+TempWidth;
  448.         end;
  449.         FillRect(TempRect);
  450.         if FGradientStyle=gsVertical then
  451.           TempTop:=Trunc(TempStepV*ColorCode)
  452.         else
  453.           TempLeft:=Trunc(TempStepH*ColorCode);
  454.       end;
  455.     end;
  456.   end;
  457.   if FGradientStyle=gsPyramid then begin
  458.     with Canvas do begin
  459.       TempLeft:=OutWidth div 2;
  460.       TempTop:=OutHeight div 2;
  461.       Pen.Width:=1;
  462.       ECount:=OutWidth+OutHeight;
  463.       TempStepH:=255/ECount;
  464.       i:=0;
  465.       while i<=OutWidth do begin
  466.         ColorCode:=trunc(TempStepH*i);
  467.         if FlipDir then
  468.           Pen.Color:=FBC[255-ColorCode]
  469.         else
  470.           Pen.Color:=FBC[ColorCode];
  471.         MoveTo(i, 0);
  472.         LineTo(TempLeft,TempTop);
  473.         ColorCode:=trunc(TempStepH*(i+OutHeight));
  474.         if FlipDir then
  475.           Pen.Color:=FBC[255-ColorCode]
  476.         else
  477.           Pen.Color:=FBC[ColorCode];
  478.         LineTo(i, OutHeight-1);
  479.         inc(i);
  480.       end;
  481.       i:=0;
  482.       while i<=OutHeight do begin
  483.         ColorCode:=trunc(TempStepH*(i+OutWidth));
  484.         if FlipDir then
  485.           Pen.Color:=FBC[255-ColorCode]
  486.         else
  487.           Pen.Color:=FBC[ColorCode];
  488.         MoveTo(OutWidth-1, i);
  489.         LineTo(TempLeft,TempTop);
  490.         ColorCode:=trunc(TempStepH*i);
  491.         if FlipDir then
  492.           Pen.Color:=FBC[255-ColorCode]
  493.         else
  494.           Pen.Color:=FBC[ColorCode];
  495.         LineTo(0, i);
  496.         inc(i);
  497.       end;
  498.     end;
  499.   end;
  500. end;
  501.  
  502. procedure TSRColorButton.LoadColors;
  503. var StartColor,
  504.     EndColor       : TColor;
  505.     AContrast,
  506.     ContrastFactor : double;
  507.     i,Start        : byte;
  508.  
  509.   procedure CalcGradientColor(FaceColor:TColor;var HighlightColor,ShadowColor:TColor;Contrast:double);
  510.   begin
  511.     {$IFDEF SR_Delphi1}
  512.     HighlightColor:=ChangeBrightness(FaceColor, 60-round(60*Contrast));
  513.     ShadowColor:=ChangeBrightness(FaceColor, -80+round(80*Contrast));
  514.     {$ELSE}
  515.     Get3DColors(FaceColor, HighlightColor, ShadowColor, Contrast, Contrast);
  516.     {$ENDIF}
  517.   end; { CalcGradientColor }
  518.  
  519. begin
  520.   ContrastFactor:=1/128;
  521.   for i:=0 to 127 do begin
  522.     AContrast:=i*ContrastFactor;
  523.     CalcGradientColor(FColor, StartColor, EndColor, AContrast);
  524.     if FGradientDirection=gdDownRight then
  525.       FBC[i]:=StartColor
  526.     else
  527.       FBC[i]:=EndColor;
  528.   end;
  529.   if FGradientDirection=gdDownRight then
  530.     Start:=127
  531.   else
  532.     Start:=128;
  533.   for i:=Start to 255 do begin
  534.     AContrast:=(255-i)*ContrastFactor;
  535.     CalcGradientColor(FColor, StartColor, EndColor, AContrast);
  536.     if FGradientDirection=gdDownRight then
  537.       FBC[i]:=EndColor
  538.     else
  539.       FBC[i]:=StartColor;
  540.   end;
  541. end;
  542.  
  543. procedure TSRColorButton.Loaded;
  544. begin
  545.   inherited Loaded;
  546.   LoadColors;
  547. end;
  548.  
  549. procedure TSRColorButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  550. begin
  551.   inherited MouseDown(Button, Shift, X, Y);
  552.   if Enabled and (Button=mbLeft) then begin
  553.     FDown:=true;
  554.     FMouseDown:=True;
  555.     if FGradientStyle<>gsNone then
  556.       Invalidate
  557.     else
  558.       DrawBorder;
  559.     if FAllowTimer then begin
  560.       if FRepeatTimer=nil then
  561.         FRepeatTimer:=TTimer.Create(Self);
  562.  
  563.       FRepeatTimer.OnTimer:=TimerExpired;
  564.       FRepeatTimer.Interval:=FTimerDelay;
  565.       FRepeatTimer.Enabled:=True;
  566.     end;
  567.   end;
  568. end;
  569.  
  570. procedure TSRColorButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  571. begin
  572.   inherited MouseUp(Button, Shift, X, Y);
  573.   if Enabled and (Button=mbLeft) then begin
  574.     if not FGrouped or (FGrouped and FAllowAllUp) then
  575.       FDown:=false;
  576.     FMouseDown:=False;
  577.     if FGradientStyle<>gsNone then
  578.       Invalidate
  579.     else
  580.       DrawBorder;
  581.     if FRepeatTimer <> nil then
  582.       FRepeatTimer.Enabled  := False;
  583.     if FGrouped then
  584.       UncheckGroupButtons(FGroupIndex);
  585.     if Assigned(FOnClick) then
  586.        FOnClick(Self);
  587.   end;
  588. end;
  589.  
  590. procedure TSRColorButton.Paint;
  591. var
  592.   Dest,Source,
  593.   CRect,TextR : TRect;
  594.   outWidth,
  595.   outHeight,
  596.   TextLeft,
  597.   TextTop     : integer;
  598.   DoDrawGlyph : boolean;
  599.   outText     : array [0..79] of char;
  600. begin
  601.   CRect:=GetClientRect;
  602.   InflateRect(CRect, -FBevelWidth, -FBevelWidth);
  603.   if FBorderStyle<>bsFlat then
  604.     InflateRect(CRect, -1, -1);
  605.   Canvas.Font.Assign(Self.Font);
  606.  
  607.   with Canvas do begin
  608.     Brush.Style:=bsSolid;
  609.     Brush.Color:=FColor;
  610.     FillRect(CRect);
  611.   end;
  612.   if FGradientStyle<>gsNone then begin
  613.     DrawGradient;
  614.     Canvas.Brush.Style:=bsClear;
  615.   end;
  616.  
  617.   {$IFDEF SR_Delphi3_Up}
  618.   DoDrawGlyph:=true;
  619.   {$ELSE}
  620.   DoDrawGlyph:=FGradientStyle=gsNone;
  621.   {$ENDIF}
  622.  
  623.   with Canvas do begin
  624.     { Glyph anzeigen }
  625.     outWidth:=  0;
  626.     outHeight:= 0;
  627.     if Assigned(FGlyph) and DoDrawGlyph then begin
  628.       with Source do begin
  629.         { Source-Rechteck ermitteln }
  630.         Left:=0;
  631.         Right:=FGlyph.Width;
  632.         Top:=0;
  633.         Bottom:=FGlyph.Height;
  634.         if FNumGlyphs>0 then
  635.           Right:=Right div FNumGlyphs;
  636.       end;
  637.       if FNumGlyphs > 0 then begin
  638.  
  639.         if(Not Enabled and (FNumGlyphs > 1)) then begin
  640.           { disabled button }
  641.           Source.Left:=  FGlyph.width div FNumGlyphs;
  642.           Source.Right:= Source.Left shl 1;
  643.         end;
  644.         { Gr÷▀e des Destination-Rechtecks }
  645.         outWidth:=  Source.Right-Source.Left;
  646.         outHeight:= Source.Bottom-Source.Top;
  647.         { Glyph-Position ermitteln }
  648.         if (Caption='') or (FLayout=blGlyphTop) or (FLayout=blGlyphBottom) then begin
  649.           Dest.Left:=  ((CRect.Right-outWidth) shr 1);
  650.           Dest.Right:= Dest.Left+outWidth;
  651.         end;
  652.         if (Caption<>'') and (FLayout=blGlyphLeft) then begin
  653.           Dest.Left:=  ((CRect.Right-(outWidth+FSpacing+TextWidth(Caption))) shr 1)-FMargin;
  654.           Dest.Right:= Dest.Left+outWidth;
  655.         end;
  656.         if (Caption<>'') and (FLayout=blGlyphRight) then begin
  657.           Dest.Left:=  ((CRect.Right+(outWidth+FSpacing+TextWidth(Caption))) shr 1)-outWidth+FMargin;
  658.           Dest.Right:= Dest.Left+outWidth;
  659.         end;
  660.         if (Caption='') or (FLayout=blGlyphLeft) or (FLayout=blGlyphRight) then begin
  661.           Dest.Top:=   ((CRect.Top+CRect.Bottom-outHeight) shr 1);
  662.           Dest.Bottom:=Dest.Top+outHeight;
  663.         end;
  664.         if (Caption<>'') and (FLayout=blGlyphTop) then begin
  665.           Dest.Top:=  ((CRect.Top+CRect.Bottom-(outHeight+FSpacing+TextHeight(Caption))) shr 1)-FMargin;
  666.           Dest.Bottom:= Dest.Top+outHeight;
  667.         end;
  668.         if (Caption<>'') and (FLayout=blGlyphBottom) then begin
  669.           Dest.Top:=  ((CRect.Top+CRect.Bottom-(outHeight+FSpacing+TextHeight(Caption))) shr 1)-outHeight+FMargin;
  670.           Dest.Bottom:= Dest.Top+outHeight;
  671.         end;
  672.         if FGradientStyle=gsNone then begin
  673.           Pen.Style := psSolid;
  674.           Pen.Color := Color;
  675.         end
  676.         else
  677.           Pen.Style := psClear;
  678.         if FDown then begin
  679.           { Glyph um 1 Pixel nach rechts unten verschieben }
  680.           Inc(Dest.Left);
  681.           Inc(Dest.Right);
  682.           Inc(Dest.Top);
  683.           Inc(Dest.Bottom);
  684.           { verbleibende Up-Reste l÷schen }
  685.           MoveTo(Dest.Left-1, Dest.Bottom);
  686.           LineTo(Dest.Left-1, Dest.Top-1);
  687.           LineTo(Dest.Right, Dest.Top-1);
  688.         end
  689.         else begin
  690.           { verbleibende Down-Reste l÷schen }
  691.           MoveTo(Dest.Right, Dest.Top);
  692.           LineTo(Dest.Right, Dest.Bottom);
  693.           LineTo(Dest.Left, Dest.Bottom);
  694.         end;
  695.         if (FDown and (FNumGlyphs > 2)) then begin
  696.           { Glyph fⁿr gedrⁿckten Zustand bestimmen }
  697.           Source.Left:= FGlyph.width div FNumGlyphs * 2;
  698.           Source.Right:=FGlyph.width div FNumGlyphs * 3;
  699.         end;
  700.         if FGradientStyle=gsNone then begin
  701.           Brush.Style:= bsSolid;
  702.           Brush.Color:= Color;
  703.         end
  704.         else
  705.           Brush.Style:=bsClear;
  706.  
  707.         { Glyph zeichnen }
  708.         BrushCopy(Dest, FGlyph, Source, FGlyph.Canvas.Pixels[0,FGlyph.Height-1]);
  709.       end;
  710.     end;
  711.  
  712.     { Caption zeichnen }
  713.     if Caption<>'' then begin
  714.       { Position ermitteln }
  715.       TextLeft:=(CRect.Right-TextWidth(Caption)) div 2;
  716.       if Assigned(FGlyph) and DoDrawGlyph and (FNumGlyphs > 0) and (FLayout=blGlyphRight) then
  717.         TextLeft:=Dest.Left-TextWidth(Caption)-FSpacing;
  718.       if Assigned(FGlyph) and DoDrawGlyph and (FNumGlyphs > 0) and (FLayout=blGlyphLeft) then
  719.         TextLeft:=Dest.Left+outWidth+FSpacing;
  720.       if FChangeDirection and FDown then
  721.         TextTop:=((CRect.Top+CRect.Bottom-TextHeight(Caption)) div 2)-FTopMargin
  722.       else
  723.         TextTop:=((CRect.Top+CRect.Bottom-TextHeight(Caption)) div 2)+FTopMargin;
  724.       if Assigned(FGlyph) and DoDrawGlyph and (FNumGlyphs > 0) and (FLayout=blGlyphTop) then
  725.         TextTop:=Dest.Top+outHeight+FSpacing;
  726.       if Assigned(FGlyph) and DoDrawGlyph and (FNumGlyphs > 0) and (FLayout=blGlyphBottom) then
  727.         TextTop:=Dest.Top-TextHeight(Caption)-FSpacing;
  728.       if FDown then
  729.         inc(TextTop);
  730.       { Text ausgeben }
  731.       if FGradientStyle=gsNone then begin
  732.         Brush.Style:= bsSolid;
  733.         Brush.Color:= Color;
  734.       end
  735.       else
  736.         Brush.Style:=bsClear;
  737.       if FDown then
  738.         { verbleibende Up-Reste l÷schen }
  739.         FillRect(Rect( TextLeft, TextTop, TextLeft+TextWidth(Caption), TextTop+TextHeight(Caption)))
  740.       else
  741.         { verbleibende Down-Reste l÷schen }
  742.         FillRect(Rect( TextLeft+1, TextTop+1, TextLeft+1+TextWidth(Caption), TextTop+1+TextHeight(Caption)));
  743.       TextR:=Rect( TextLeft, TextTop, TextLeft+TextWidth(Caption), TextTop+TextHeight(Caption));
  744.       StrPCopy(outText, Caption);
  745.       if not Enabled then
  746.         Font.Color:=clGrayText;
  747.       DrawText(Handle, outText, length(Caption), TextR, DT_Center or DT_VCenter or DT_SingleLine);
  748.     end;
  749.   end;
  750.   DrawBorder;
  751. end;
  752.  
  753. procedure TSRColorButton.SetAllowAllUp(newValue: boolean);
  754. begin
  755.   if FAllowAllUp<>NewValue then begin
  756.     FAllowAllUp:=NewValue;
  757.     if not FAllowAllUp and FGrouped and not FDown then begin
  758.       { prⁿfen, ob ein anderer Button der Gruppe gedrⁿckt ist }
  759.     end;
  760.   end;
  761. end;
  762.  
  763. procedure TSRColorButton.SetBevelWidth(NewValue: integer);
  764. begin
  765.   if (FBevelWidth<>NewValue) and (NewValue>=0) and (NewValue<(Height div 2)) and (NewValue<(Width div 2)) then begin
  766.     FBevelWidth:=NewValue;
  767.     Invalidate;
  768.   end;
  769. end;
  770.  
  771. procedure TSRColorButton.SetBorderColor(newColor: TColor);
  772. begin
  773.   if newColor<>FBorderColor then begin
  774.     FBorderColor:=newColor;
  775.     Invalidate;
  776.   end;
  777. end;
  778.  
  779. procedure TSRColorButton.SetBorderStyle(newValue: TBorderStyle);
  780. begin
  781.   if FBorderStyle<>newValue then begin
  782.     FBorderStyle:=newValue;
  783.     Invalidate;
  784.   end;
  785. end;
  786.  
  787. procedure TSRColorButton.SetChangeDirection(newValue: boolean);
  788. begin
  789.   if FChangeDirection<>newValue then begin
  790.     FChangeDirection:=newValue;
  791.     if (FGradientStyle<>gsNone) and FDown then
  792.       Invalidate;
  793.   end;
  794. end;
  795.  
  796. procedure TSRColorButton.SetColor(newColor: TColor);
  797. begin
  798.   if FColor<>newColor then begin
  799.     FColor:=newColor;
  800.     AssignBevelColors(FColor,FColorHighlight,FColorShadow,FContrastHighlight,FContrastShadow);
  801.     if FGradientStyle<>gsNone then
  802.       LoadColors;
  803.     Invalidate;
  804.   end;
  805. end;
  806.  
  807. procedure TSRColorButton.SetContrastHighlight(newValue: TContrast);
  808. begin
  809.   if (FContrastHighlight<>NewValue) and (NewValue>=0) and (NewValue<10) then begin
  810.     FContrastHighlight:=NewValue;
  811.     AssignBevelColors(FColor,FColorHighlight,FColorShadow,FContrastHighlight,FContrastShadow);
  812.     if FGradientStyle<>gsNone then
  813.       LoadColors;
  814.     Invalidate;
  815.   end;
  816. end;
  817.  
  818. procedure TSRColorButton.SetContrastShadow(newValue: TContrast);
  819. begin
  820.   if (FContrastShadow<>NewValue) and (NewValue>=0) and (NewValue<10) then begin
  821.     FContrastShadow:=NewValue;
  822.     AssignBevelColors(FColor,FColorHighlight,FColorShadow,FContrastHighlight,FContrastShadow);
  823.     if FGradientStyle<>gsNone then
  824.       LoadColors;
  825.     Invalidate;
  826.   end;
  827. end;
  828.  
  829. procedure TSRColorButton.SetDown(newValue: boolean);
  830. begin
  831.   if FDown<>newValue then begin
  832.     FDown:=newValue;
  833.     if FGradientStyle<>gsNone then
  834.       Invalidate
  835.     else
  836.       DrawBorder;
  837.   end;
  838. end;
  839.  
  840. procedure TSRColorButton.SetGlyph(newGlyph: TBitmap);
  841. begin
  842.   if Assigned(FGlyph) then begin
  843.     FGlyph.Assign(newGlyph);
  844.     if (csDesigning in ComponentState) then begin
  845.       { Glyph 1: Normal, 2: Disabled, 3: Down;
  846.         Mu▀ die Ausma▀e (Height * NumGlyphs) = Width  haben }
  847.       if (newGlyph.width mod newGlyph.height = 0) then
  848.         FNumGlyphs:= newGlyph.width div newGlyph.height
  849.       else
  850.         FNumGlyphs:= 1;
  851.     end;
  852.     Invalidate;
  853.   end;
  854. end;
  855.  
  856. procedure TSRColorButton.SetGradientDirection(newValue: TGradDirection);
  857. begin
  858.   if FGradientDirection<>newValue then begin
  859.     FGradientDirection:=newValue;
  860.     LoadColors;
  861.     Invalidate;
  862.   end;
  863. end;
  864.  
  865. procedure TSRColorButton.SetGradientStyle(newValue: TGradientStyle);
  866. begin
  867.   if FGradientStyle<>newValue then begin
  868.     FGradientStyle:=newValue;
  869.     Invalidate;
  870.   end;
  871. end;
  872.  
  873. procedure TSRColorButton.SetLayout(newValue: TButtonLayout);
  874. begin
  875.   if FLayout<>newValue then begin
  876.     FLayout:=newValue;
  877.     Invalidate;
  878.   end;
  879. end;
  880.  
  881. procedure TSRColorButton.SetMargin(newValue: integer);
  882. begin
  883.   if FMargin<>newValue then begin
  884.     FMargin:=newValue;
  885.     Invalidate;
  886.   end;
  887. end;
  888.  
  889. procedure TSRColorButton.SetNumGlyphs(newNumGlyphs: TNumGlyphs);
  890. begin
  891.   if FNumGlyphs<>newNumGlyphs then begin
  892.     FNumGlyphs:= newNumGlyphs;
  893.     Invalidate;
  894.   end;
  895. end;
  896.  
  897. procedure TSRColorButton.SetSpacing(newValue: integer);
  898. begin
  899.   if FSpacing<>newValue then begin
  900.     FSpacing:=newValue;
  901.     Invalidate;
  902.   end;
  903. end;
  904.  
  905. procedure TSRColorButton.SetTopMargin(newValue: integer);
  906. begin
  907.   if FTopMargin<>newValue then begin
  908.     FTopMargin:=newValue;
  909.     Invalidate;
  910.   end;
  911. end;
  912.  
  913. procedure TSRColorButton.TimerExpired(Sender: TObject);
  914. begin
  915.   FRepeatTimer.Interval:=FTimerInterval;
  916.   if FDown and Enabled and MouseCapture then begin
  917.     try
  918.       Click;
  919.     except
  920.       FRepeatTimer.Enabled:=False;
  921.       raise;
  922.     end;
  923.   end;
  924. end;
  925.  
  926. procedure TSRColorButton.UncheckGroupButtons(AIndex: integer);
  927. var i : integer;
  928. begin
  929.   for i:=0 to Self.Parent.ControlCount-1 do
  930.     if Self.Parent.Controls[i] is TSRColorButton then
  931.       if (TSRColorButton(Self.Parent.Controls[i])<>Self)
  932.        and TSRColorButton(Self.Parent.Controls[i]).Grouped
  933.        and (TSRColorButton(Self.Parent.Controls[i]).GroupIndex=AIndex)
  934.        and TSRColorButton(Self.Parent.Controls[i]).Down then
  935.          TSRColorButton(Self.Parent.Controls[i]).Down:=false;
  936. end;
  937.  
  938. procedure TSRColorButton.WMEraseBkgnd(var Message: TWMEraseBkgnd);
  939. begin
  940.   Message.Result:=1;
  941. end;
  942.  
  943. procedure Register;
  944. begin
  945.   RegisterComponents('Simon',[TSRColorButton]);
  946. end;
  947.  
  948. end.
  949.