Chip 2002 March/Chip_2002-03_cd1.bin/zkuste/delphi/kolekce/d123456/SIMONS.ZIP/Units/SRClock.pas

Pascal/Delphi Source File | 2001-10-21 | 26.4 KB | 920 lines

unit Srclock;

{ TSRClock (C)opyright 2001 Version 1.40
  Autor : Simon Reinhardt
  eMail : [e-mail]
  Internet : http://www.picsoft.de

  Die SRClock-Komponente stellt eine analoge oder digitale Uhr in verschiedenen
  Designs dar und verfⁿgt ⁿber einen Timer, der in einem eigenen Thread lΣuft.
  Die Uhr kann auch als Stopuhr verwendet werden.

  Diese Komponenten sind Public Domain, das Urheberrecht liegt aber beim Autor. }

interface

{$I SRDefine.inc}

uses {$IFDEF SR_Win32} Windows, {$ELSE} WinTypes, WinProcs, Menus, {$ENDIF}
  Classes, Controls, Messages, Forms, Graphics, StdCtrls, Grids, SysUtils;

type
  TClockStyle = (csClassic, csDigital, csMovingPoints, csPieSlice);
  TClockKind = (ckRealTime, ckStopWatch);
  TContrast = 0..9;
  TNumbers = (snAll, snNone, snQuarters);
  TTime = TDateTime;

  TThreadTimer = class;

  TTimerThread = class(TThread)
    OwnerTimer: TThreadTimer;
    procedure Execute; override;
  end;

  TThreadTimer = class(TComponent)
  private
    FEnabled        : boolean;
    FInterval       : word;
    FOnTimer        : TNotifyEvent;
    FTimerThread    : TTimerThread;
    FThreadPriority : TThreadPriority;

    procedure SetEnabled(Value: Boolean);
    procedure SetInterval(Value: word);
    procedure SetThreadPriority(Value: TThreadPriority);
    procedure Timer; dynamic;

  protected
    procedure UpdateTimer;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property TimerThread: TTimerThread read FTimerThread write FTimerThread;

  published
    property Enabled: boolean read FEnabled write SetEnabled default True;
    property Interval: word read FInterval write SetInterval default 250;
    property Priority: TThreadPriority read FThreadPriority write SetThreadPriority default tpNormal;
    property OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
  end;

  TSRClock = class(TGraphicControl)
  private
    FAutoUpdate           : boolean;
    FBorderWidth          : integer;
    FColorBackground,
    FColorBorder,
    FColorHands,
    FColorNumbers,
    FColorSegments        : TColor;
    FDigit                : array [0..9] of TBitmap;
    FFadingColor          : boolean;
    FHour,FMinute,FSecond : word;
    FKind                 : TClockKind;
    FLEDContrast          : TContrast;
    FLineWidth            : integer;
    FPriority             : TThreadPriority;
    FOldWidth,FOldHeight  : integer;
    FRunning              : boolean;
    FSegCl                : array [0..9, 1..7] of TColor;
    FShowNumbers          : TNumbers;
    FShowSeconds,
    FShowTicks,
    FSummertime           : boolean;
    FStyle                : TClockStyle;
    FTime                 : TTime;
    FTimeOffset           : double;
    FUpdateInterval       : word;

    FOnMouseEnter,
    FOnMouseExit,
    FOnTimer              : TNotifyEvent;

    Timer                 : TThreadTimer;
    Buffer                : TBitmap;

    function  GetPriority: TThreadPriority;
    procedure SetAutoUpdate(Value: boolean);
    procedure SetBorderWidth(Value: integer);
    procedure SetColorBackground(Value: TColor);
    procedure SetColorBorder(Value: TColor);
    procedure SetColorNumbers(Value: TColor);
    procedure SetColorHands(Value: TColor);
    procedure SetFadingColor(Value: boolean);
    procedure SetKind(Value: TClockKind);
    procedure SetLEDContrast(Value : TContrast);
    procedure SetLineWidth (Value: integer);
    procedure SetPriority(Value: TThreadPriority);
    procedure SetShowNumbers(Value: TNumbers);
    procedure SetShowSeconds(Value: boolean);
    procedure SetShowTicks(Value: boolean);
    procedure SetStyle(Value: TClockStyle);
    procedure SetTime(Value: TTime);
    procedure SetUpdateInterval(Value: word);

    procedure AssignColors (seg: integer; s1,s2,s3,s4,s5,s6,s7: Boolean);
    procedure GenerateBitMaps(AWidth, AHeight: integer);

  protected
    procedure Paint;  override;
    procedure Loaded; override;
    procedure AutoUpdateClock(Sender: TObject);
    procedure CmEnabledChanged(var Message: TWmNoParams); message CM_ENABLEDCHANGED;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure CmVisibleChanged(var Message: TWmNoParams); message CM_VISIBLECHANGED;

  public
    property Hour: word read FHour;
    property Minute: word read FMinute;
    property Second: word read FSecond;
    property Time: TTime read FTime write SetTime;
    property Summertime: boolean read FSummertime;

    procedure Reset;
    procedure Start;
    procedure Stop;

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

  published
    property Align;
    {$IFDEF SR_Delphi5_Up}
    property Anchors;
    {$ENDIF}
    property AutoUpdate: boolean read FAutoUpdate write SetAutoUpdate;
    property BorderWidth: integer read FBorderWidth write SetBorderWidth;
    property ColorBackground: TColor read FColorBackground write SetColorBackground;
    property ColorBorder: TColor read FColorBorder write SetColorBorder;
    property ColorNumbers: TColor read FColorNumbers write SetColorNumbers;
    property ColorHands: TColor read FColorHands write SetColorHands;
    property DigitLineWidth: integer read FLineWidth write setLineWidth;
    property Enabled;
    property FadingColor: boolean read FFadingColor write SetFadingColor;
    property Font;
    property Kind: TClockKind read FKind write SetKind;
    property LEDContrast: TContrast read FLEDContrast write SetLEDContrast;
    property Priority: TThreadPriority read GetPriority write SetPriority default tpNormal;
    property ShowNumbers: TNumbers read FShowNumbers write SetShowNumbers;
    property ShowSeconds: boolean read FShowSeconds write SetShowSeconds;
    property ShowTicks: boolean read FShowTicks write SetShowTicks;
    property Style: TClockStyle read FStyle write SetStyle;
    property UpdateInterval: word read FUpdateInterval write SetUpdateInterval;
    property Visible;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseExit: TNotifyEvent read FOnMouseExit  write FOnMouseExit;
    property OnMouseMove;
    property OnMouseUp;
    property OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
    property OnStartDrag;
  end;

procedure Register;

implementation

uses SRUtils, rrColors;

function XKoord(XMittel,XRadius,Grad:word):word;
begin
  Result:=round(XMittel-(sin(Grad*Pi/180)*XRadius));
end; {XKoord}

function YKoord(YMittel,YRadius,Grad:word):word;
begin
  Result:=round(YMittel-(cos(Grad*Pi/180)*YRadius));
end; {YKoord}

function CalcShadowedColors(AColor:TColor;AContrast:integer):TColor;
var Dummy : TColor;
begin
  Get3DColors(AColor,Dummy,REsult,(10-AContrast)/10,(10-AContrast)/10);
end;

{ Klasse TThreadTimer }
procedure TTimerThread.Execute;
begin
  Priority := OwnerTimer.Priority;
  repeat
    SleepEx(OwnerTimer.Interval, False);
    Synchronize(OwnerTimer.Timer);
  until Terminated;
end;

procedure TThreadTimer.UpdateTimer;
begin
  if not TimerThread.Suspended then
    TimerThread.Suspend;
  if (FInterval <> 0) and FEnabled then
    if TimerThread.Suspended then
      TimerThread.Resume;
end;

procedure TThreadTimer.SetEnabled(Value: boolean);
begin
  if Value<>FEnabled then begin
    FEnabled:=Value;
    UpdateTimer;
  end;
end;

procedure TThreadTimer.SetInterval(Value: Word);
begin
  if Value<>FInterval then begin
    FInterval:=Value;
    UpdateTimer;
  end;
end;

procedure TThreadTimer.SetThreadPriority(Value: TThreadPriority);
begin
  if Value<>FThreadPriority then begin
    FThreadPriority:=Value;
    UpdateTimer;
  end;
end;

procedure TThreadTimer.Timer;
begin
  if Assigned(FOntimer) then
    FOnTimer(Self);
end;

constructor TThreadTimer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FEnabled := True;
  FInterval := 250;
  FThreadPriority := tpNormal;
  FTimerThread := TTimerThread.Create(False);
  FTimerThread.OwnerTimer := Self;
end;

destructor TThreadTimer.Destroy;
begin
  FEnabled := False;
  UpdateTimer;
  FTimerThread.Free;
  inherited Destroy;
end;

{ Komponente TSRClock }

procedure TSRClock.AssignColors (seg: integer; s1,s2,s3,s4,s5,s6,s7: Boolean);
begin
  if s1 then
    FSegCl[seg, 1] := FColorNumbers
  else
    FSegCl[seg, 1] := FColorSegments;
  if s2 then
    FSegCl[seg, 2] := FColorNumbers
  else
    FSegCl[seg, 2] := FColorSegments;
  if s3 then
    FSegCl[seg, 3] := FColorNumbers
  else
    FSegCl[seg, 3] := FColorSegments;
  if s4 then
    FSegCl[seg, 4] := FColorNumbers
  else
    FSegCl[seg, 4] := FColorSegments;
  if s5 then
    FSegCl[seg, 5] := FColorNumbers
  else
    FSegCl[seg, 5] := FColorSegments;
  if s6 then
    FSegCl[seg, 6] := FColorNumbers
  else
    FSegCl[seg, 6] := FColorSegments;
  if s7 then
    FSegCl[seg, 7] := FColorNumbers
  else
    FSegCl[seg, 7] := FColorSegments;
end;

procedure TSRClock.GenerateBitMaps(AWidth, AHeight: integer);
var
  TL, TR, TBL, TBR,
  ML, MTL, MTR, MR,
  MBL, MBR, BL, BTL,
  BTR, BR            : TPoint;
  c, wAlt, LineW,
  DigitW             : integer;
begin
  LineW:=FLineWidth+2;
  DigitW:=round((AWidth-12)/8);
  wAlt := AHeight-4;
  { Polygonpunkte zuweisen }
  TL.x := 0;
  TL.y := 0;
  TR.x := DigitW-1;
  TR.y := 0;
  TBL.x := LineW - 1;
  TBL.y := LineW -1;
  TBR.x := DigitW - LineW;
  TBR.y := TBL.y;
  ML.x := 0;
  ML.y := wAlt div 2;
  MTL.x := TBL.x;
  MTL.y := ML.y - (LineW div 2);
  MTR.x := TBR.x;
  MTR.y := MTL.y;
  MR.x := TR.x;
  MR.y := ML.y;
  MBL.x := TBL.x;
  MBL.y := ML.y + (LineW div 2);
  MBR.x := MTR.x; MBR.y := MBL.y;
  BL.x := 0;
  BL.y := wAlt - 1;
  BR.x := TR.x;
  BR.y := BL.y;
  BTL.x := TBL.x;
  BTL.y := wAlt - LineW;
  BTR.x := TBR.x;
  BTR.y := BTL.y;

  { Segmentfarben zuweisen }
  AssignColors (0,true,true,true,false,true,true,true);
  AssignColors (1,false,false,true,false,false,true,false);
  AssignColors (2,true,false,true,true,true,false,true);
  AssignColors (3,true,false,true,true,false,true,true);
  AssignColors (4,false,true,true,true,false,true,false);
  AssignColors (5,true,true,false,true,false,true,true);
  AssignColors (6,false,true,false,true,true,true,true);
  AssignColors (7,true,false,true,false,false,true,false);
  AssignColors (8,true,true,true,true,true,true,true);
  AssignColors (9,true,true,true,true,false,true,true);

  { Bitmap erstellen }
  for c := 0 to 9 do begin
    FDigit[c].free;
    FDigit[c] := TBitmap.create;
    FDigit[c].width := DigitW;
    FDigit[c].height := wAlt;
    with FDigit[c].canvas do begin
      Pen.Color := ColorBorder;
      Brush.Color := FColorBackGround;
      Brush.style := bsSolid;
      Pen.Width := 1;
      Rectangle (TL.x, TL.y, BR.x+1, BR.y+1);
      { Segment 1 }
      Brush.Color := FSegCl[c, 1];
      Polygon ([TL, TR, TBR, TBL]);
      { Segment 2 }
      Brush.Color := FSegCl[c, 2];
      Polygon ([TL, TBL, MTL, ML]);
      { Segment 3 }
      Brush.Color := FSegCl[c, 3];
      Polygon ([TR, MR, MTR, TBR]);
      { Segment 4 }
      Brush.Color := FSegCl[c, 4];
      Polygon ([ML, MTL, MTR, MR, MBR, MBL]);
      { Segment 5 }
      Brush.Color := FSegCl[c, 5];
      Polygon ([ML, MBL, BTL, BL]);
      { Segment 6 }
      Brush.Color := FSegCl[c, 6];
      Polygon ([MR, BR, BTR, MBR]);
      { Segment 7 }
      Brush.Color := FSegCl[c, 7];
      Polygon ([BL, BTL, BTR, BR]);
    end;
  end;
end;

constructor TSRClock.Create(AOwner: TComponent);
var msec : word;
begin
  inherited Create(AOwner);
  {  defaults  }
  Buffer := TBitmap.Create;

  FUpdateInterval:=1000;
  Timer := TThreadTimer.Create(self);
  Timer.Interval := FUpdateInterval;
  Timer.OnTimer := AutoUpdateClock;

  FTime:=Now;
  try
    DecodeTime(FTime,FHour,FMinute,FSecond,msec);
  except
  end;

  FAutoUpdate:=false;
  FBorderWidth:=2;
  FColorBackGround:=clWindow;
  FColorBorder:=clWindowFrame;
  FColorNumbers:=clBlue;
  FLEDContrast:=6;
  FColorSegments:=CalcShadowedColors(FColorNumbers, FLEDContrast);
  FColorHands:=clNavy;
  FLineWidth:= 3;
  FPriority := tpNormal;
  FRunning:=false;
  FShowNumbers:=snQuarters;
  FShowSeconds:=true;
  FShowTicks:=true;
  FSummertime:=IsSummertime(Now);
  FStyle:=csClassic;

  SetBounds(0,0,80,80);

  FOldWidth:=Self.Width;
  FOldHeight:=Self.Height;
  if FStyle=csDigital then
    GenerateBitMaps(Self.Width, Self.Height);
end;

destructor TSRClock.Destroy;
begin
  Buffer.Free;
  Timer.Free;
  inherited Destroy;
end;

procedure TSRClock.Loaded;
begin
  inherited Loaded;
  Buffer.Width := Self.ClientWidth;
  Buffer.Height := Self.ClientHeight;
  Buffer.Canvas.Brush.Color := Color;
end;

procedure TSRClock.CmEnabledChanged(var Message: TWmNoParams);
begin
  inherited;
  Timer.Enabled := Self.Enabled;
  Invalidate;
end;

procedure TSRClock.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  if Assigned(FOnMouseEnter) then
    FOnMouseEnter(Self);
end;

procedure TSRClock.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  if Assigned(FOnMouseExit) then
    FOnMouseExit(Self);
end;

procedure TSRClock.CmVisibleChanged(var Message: TWmNoParams);
begin
  inherited;
  Invalidate;
end;

function TSRClock.GetPriority: TThreadPriority;
begin
  Result := Timer.Priority;
end;

procedure TSRClock.SetAutoUpdate(Value: boolean);
begin
  if (FAutoUpdate<>Value) and (FKind=ckRealTime) then begin
    FAutoUpdate:=Value;
    Timer.Enabled := FAutoUpdate;
  end;
end;

procedure TSRClock.SetBorderWidth(Value: integer);
begin
  if Value<>FBorderWidth then begin
    FBorderWidth:=Value;
    if FStyle=csDigital then
      GenerateBitMaps(Self.Width, Self.Height);
    Invalidate;
  end;
end;

procedure TSRClock.SetColorBackground(Value: TColor);
begin
  if Value<>FColorBackground then begin
    FColorBackground:=Value;
    if FStyle=csDigital then
      GenerateBitMaps(Self.Width, Self.Height);
    Invalidate;
  end;
end;

procedure TSRClock.SetColorBorder(Value: TColor);
begin
  if Value<>FColorBorder then begin
    FColorBorder:=Value;
    Invalidate;
  end;
end;

procedure TSRClock.SetColorNumbers(Value: TColor);
begin
  if Value<>FColorNumbers then begin
    FColorNumbers:=Value;
    FColorSegments:=CalcShadowedColors(FColorNumbers, FLEDContrast);
    if FStyle=csDigital then
      GenerateBitMaps(Self.Width, Self.Height);
    Invalidate;
  end;
end;

procedure TSRClock.SetColorHands(Value: TColor);
begin
  if Value<>FColorHands then begin
    FColorHands:=Value;
    Invalidate;
  end;
end;

procedure TSRClock.SetFadingColor(Value: boolean);
begin
  if Value<>FFadingColor then begin
    FFadingColor:=Value;
    Invalidate;
  end;
end;

procedure TSRClock.SetKind(Value: TClockKind);
begin
  if Value<>FKind then begin
    FKind:=Value;
    if FKind=ckRealTime then
      FTime:=Now
    else begin
      FRunning:=false;
      FTimeOffset:=Now;
      FTime:=0;
    end;
    Invalidate;
  end;
end;

procedure TSRClock.SetLEDContrast(Value: TContrast);
begin
  if (FLEDContrast<>Value) and (Value>=0) and (Value<10) then begin
    FLEDContrast:=Value;
    FColorSegments:=CalcShadowedColors(FColorNumbers, FLEDContrast);
    if FStyle=csDigital then
      GenerateBitMaps(Self.Width, Self.Height);
    Invalidate;
  end;
end;

procedure TSRClock.SetLineWidth (Value: integer);
begin
  if FLineWidth<>Value then begin
    FLineWidth:=Value;
    if FStyle=csDigital then
      GenerateBitMaps(Self.Width, Self.Height);
    Invalidate;
  end;
end;

procedure TSRClock.SetPriority(Value: TThreadPriority);
begin
  if Value<>FPriority then begin
    FPriority:=Value;
    Timer.Priority := FPriority;
  end;
end;

procedure TSRClock.SetShowNumbers(Value: TNumbers);
begin
  if Value<>FShowNumbers then begin
    FShowNumbers:=Value;
    Invalidate;
  end;
end;

procedure TSRClock.SetShowSeconds(Value: boolean);
begin
  if Value<>FShowSeconds then begin
    FShowSeconds:=Value;
    Invalidate;
  end;
end;

procedure TSRClock.SetShowTicks(Value: boolean);
begin
  if Value<>FShowTicks then begin
    FShowTicks:=Value;
    Invalidate;
  end;
end;

procedure TSRClock.SetStyle(Value: TClockStyle);
begin
  if Value<>FStyle then begin
    FStyle:=Value;
    if FStyle=csDigital then
      GenerateBitMaps(Self.Width, Self.Height);
    Invalidate;
  end;
end;

procedure TSRClock.SetTime(Value: TTime);
var msec : word;
begin
  if Value<>FTime then begin
    FTime:=Value;
    try
      DecodeTime(FTime,FHour,FMinute,FSecond,msec);
    except
      FHour:=0;
      FMinute:=0;
      FSecond:=0;
    end;
    Paint;
  end;
end;

procedure TSRClock.SetUpdateInterval(Value: word);
begin
  if Value<>FUpdateInterval then begin
    FUpdateInterval:=Value;
    Timer.Interval:=FUpdateInterval;
    Invalidate;
  end;
end;

procedure TSRClock.AutoUpdateClock(Sender: TObject);
begin
  if ((Kind=ckRealTime) and FAutoUpdate) or ((Kind=ckStopWatch) and FRunning) then begin
    if Kind=ckStopWatch then
      SetTime(Now-FTimeOffset)
    else
      SetTime(Now);
    if Assigned(FOnTimer) then
      FOnTimer(Self);
  end;
end;

procedure TSRClock.Reset;
begin
  FTimeOffset:=Now;
  FTime:=0;
  Invalidate;
end;

procedure TSRClock.Start;
begin
  FTimeOffset:=Now-FTime;
  FRunning:=true;
end;

procedure TSRClock.Stop;
begin
  FRunning:=false;
end;

procedure TSRClock.Paint;
var ARect       : TRect;
    Center,
    ElCenter    : TPoint;
    i           : byte;
    XRadius,
    YRadius,
    ElXRadius,
    ElYRadius,
    Grad        : word;
    anchoPosi,
    posiLeft,
    PosiTop, c,
    SepPosition : integer;
    outText     : string;
    ElXAbstand,
    ElYAbstand  : double;

  procedure AlTextOut(X,Y:integer;Text:string;HAlign,VAlign:TAlignment);
  var LeftOut,TopOut : integer;
  begin
    with Buffer.Canvas do begin
      LeftOut:=X;
      if HAlign=taRightJustify then
        LeftOut:=X-TextWidth(Text);
      if HAlign=taCenter then
        LeftOut:=X-(TextWidth(Text) div 2);
      TopOut:=Y;
      if VAlign=taRightJustify then
        TopOut:=Y-TextHeight(Text);
      if VAlign=taCenter then
        TopOut:=Y-(TextHeight(Text) div 2);
      TextOut(LeftOut,TopOut,Text);
    end;
  end; { AlTextOut }

begin
  Buffer.Width := Self.Width;
  Buffer.Height := Self.Height;
  ARect:=GetClientRect;
  Center.X:=(ARect.Right-ARect.Left) div 2;
  Center.Y:=(ARect.Bottom-ARect.Top) div 2;
  with Buffer.Canvas do begin
    Font.Assign(Self.Font);
    Brush.Color := Self.Color;
    Brush.Style := bsSolid;
    Pen.Color := Self.Color;
    Rectangle(0, 0, Width, Height);

    if Style=csDigital then begin
      if (FOldWidth<>Self.Width) or (FOldHeight<>Self.Height) then
        GenerateBitmaps(Self.Width, Self.Height);
      Brush.Color := ColorBackground;
      Pen.Color := ColorBorder;
      Rectangle(0, 0, Width, Height);
      try
        outText:=FormatDateTime('hh:mm:ss', FTime);
      except
        outText:='';
      end;
      anchoPosi := round((Self.Width-4)/8);
      PosiTop := (Self.Height - (Self.Height-4)) div 2;
      posiLeft := ((anchoPosi - round((Self.Width)/8)) div 2)+3;
      Brush.Color := FColorNumbers;
      Pen.Color := FColorNumbers;
      { Bitmaps und DecSeperator zeichnen }
      for c := 1 to 8 do begin
        { nachfolgende Nullen mⁿssen gezeichnet werden! }
        if outText[c]=':' then begin
          Pen.Width:=1;
          Ellipse(posiLeft+round((Width-12)/16), posiTop+((Height-4) div 3)-2,
                  posiLeft+FLineWidth+round((Width-12)/16), posiTop+((Height-4) div 3)-2+FLineWidth);
          Ellipse(posiLeft+round((Width-12)/16), posiTop+((Height-4)*2 div 3)-2,
                  posiLeft+FLineWidth+round((Width-12)/16), posiTop+((Height-4)*2 div 3)-2+FLineWidth);
        end
        else
          Draw (posiLeft, posiTop, FDigit[strToInt(outText[c])]);
        inc (posiLeft, anchoPosi);
      end;
    end
    else begin
      { Rahmen und Hintergrund: }
      Pen.Width:=FBorderWidth;
      Pen.Color:=FColorBorder;
      Brush.Color:=FColorBackground;
      Brush.Style:=bsSolid;
      InflateRect(ARect, -FBorderWidth div 2, -FBorderWidth div 2);
      Ellipse(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
      Pen.Width:=1;
    end;
    XRadius:=(ARect.Right-ARect.Left) div 2;
    YRadius:=(ARect.Bottom-ARect.Top) div 2;
    if Style=csClassic then begin
      { Markierungen: }
      if FShowTicks then begin
        for i:=1 to 12 do begin
          MoveTo(XKoord(Center.X-1, XRadius-1, 360-(i*30)),
                 YKoord(Center.Y-1, YRadius-1, 360-(i*30)));
          LineTo(XKoord(Center.X-1, XRadius-5, 360-(i*30)),
                 YKoord(Center.Y-1, YRadius-5, 360-(i*30)));
        end;
      end;

      { Ziffern: }
      if FShowNumbers<>snNone then begin
        Brush.Style:=bsClear;
        Font.Color:=FColorNumbers;
        for i:=1 to 12 do
          if (FShowNumbers=snAll) or ((FShowNumbers=snQuarters) and ((i mod 3)=0)) then
            AlTextOut(XKoord(Center.X, XRadius-TextWidth('3')-2, 360-(i*30)),
                      YKoord(Center.Y, YRadius-(TextHeight('1') div 2)-4, 360-(i*30)),
                      IntToStr(i), taCenter, taCenter);
      end;

      { Zeiger: }
      Pen.Color:=FColorBorder;
      Brush.Color:=FColorBorder;
      Brush.Style:=bsSolid;
      Ellipse(Center.X-(XRadius div 10), Center.Y-(YRadius div 10),
              Center.X+(XRadius div 10), Center.Y+(YRadius div 10));
      Pen.Color:=FColorHands;
      { Stunden }
      Pen.Width:=4;
      Grad:=360-((FHour mod 12)*30);
      Grad:=Grad-round(30*(FMinute/60));
      MoveTo(Center.X, Center.Y);
      LineTo(XKoord(Center.X,XRadius div 2,Grad),
             YKoord(Center.Y,YRadius div 2,Grad));
      { Minuten }
      Pen.Width:=2;
      MoveTo(Center.X, Center.Y);
      LineTo(XKoord(Center.X,XRadius-4,360-(FMinute*6)),
             YKoord(Center.Y,YRadius-4,360-(FMinute*6)));
      { Sekunden }
      if FShowSeconds then begin
        Pen.Width:=1;
        Pen.Color:=FColorNumbers;
        MoveTo(XKoord(Center.X,5,180-(FSecond*6)),
               YKoord(Center.Y,5,180-(FSecond*6)));
        LineTo(XKoord(Center.X,XRadius-4,360-(FSecond*6)),
               YKoord(Center.Y,YRadius-4,360-(FSecond*6)));
      end;
    end;
    if Style=csMovingPoints then begin
      Brush.Color:=FColorBorder;
      Brush.Style:=bsSolid;
      ElXRadius:=((XRadius-(XRadius div 5)) div 2)-2;
      ElYRadius:=((YRadius-(YRadius div 5)) div 2)-2;
      Ellipse(Center.X-ElXRadius, Center.Y-ElYRadius,
              Center.X+ElXRadius, Center.Y+ElYRadius);
      { Stunden und Minuten }
      if (FMinute=0) or not FFadingColor then
        Brush.Color:=FColorHands
      else
        Brush.Color:=CalcShadowedColors(FColorHands, round(7-(7/(60-FMinute))));
      Pen.Color:=Brush.Color;
      Grad:=360-((FHour mod 12)*30);
      Grad:=Grad-round(30*(FMinute/60));
      ElXRadius:=XRadius div 5;
      ElYRadius:=YRadius div 5;
      ElXAbstand:=(XRadius-ElXRadius)/120;
      ElYAbstand:=(YRadius-ElYRadius)/120;
      if FMinute=0 then begin
        ElCenter.X:=XKoord(Center.X, XRadius-2, Grad);
        ElCenter.Y:=YKoord(Center.Y, YRadius-2, Grad);
      end
      else begin
        ElCenter.X:=XKoord(Center.X, XRadius-2-round((60-FMinute)*ElXAbstand), Grad);
        ElCenter.Y:=YKoord(Center.Y, YRadius-2-round((60-FMinute)*ElYAbstand), Grad);
      end;
      Pie(ElCenter.X-ElXRadius, ElCenter.Y-ElYRadius,
          ElCenter.X+ElXRadius, ElCenter.Y+ElYRadius,
          XKoord(ElCenter.X, ElXRadius, Grad+135), YKoord(ElCenter.Y, ElYRadius, Grad+135),
          XKoord(ElCenter.X, ElXRadius, Grad-135), YKoord(ElCenter.Y, ElYRadius, Grad-135));
      { Sekunden }
      if FShowSeconds then begin
        Brush.Color:=FColorNumbers;
        Pen.Color:=Brush.Color;
        ElXRadius:=ElXRadius div 3;
        ElYRadius:=ElYRadius div 3;
        ElCenter.X:=XKoord(Center.X, (XRadius div 3), 360-(FSecond*6));
        ElCenter.Y:=YKoord(Center.Y, (YRadius div 3), 360-(FSecond*6));
        Ellipse(ElCenter.X-ElXRadius, ElCenter.Y-ElYRadius,
                ElCenter.X+ElXRadius, ElCenter.Y+ElYRadius);
      end;
    end;
    if Style=csPieSlice then begin
      if (FMinute=0) or not FFadingColor then
        Brush.Color:=FColorHands
      else
        Brush.Color:=CalcShadowedColors(FColorHands, round(7-(7/(60-FMinute))));
      Pen.Color:=Brush.Color;
      { Stunden und Minuten }
      ElXAbstand:=(XRadius-(XRadius div 3)-4)/60;
      ElYAbstand:=(YRadius-(YRadius div 3)-4)/60;
      if FMinute=0 then begin
        ElXRadius:=(XRadius div 3)+round(ElXAbstand*60);
        ElYRadius:=(YRadius div 3)+round(ElYAbstand*60);
      end
      else begin
        ElXRadius:=(XRadius div 3)+round(ElXAbstand*FMinute);
        ElYRadius:=(YRadius div 3)+round(ElYAbstand*FMinute);
      end;
      Grad:=360-((FHour mod 12)*30);
      Grad:=Grad-round(30*(FMinute/60));
      Pie(Center.X-ElXRadius, Center.Y-ElYRadius,
          Center.X+ElXRadius, Center.Y+ElYRadius,
          XKoord(Center.X, ElXRadius, Grad), YKoord(Center.Y, ElYRadius, Grad),
          XKoord(Center.X, ElXRadius, 0), YKoord(Center.Y, ElYRadius, 0));
      Brush.Color:=FColorBorder;
      Brush.Style:=bsSolid;
      Pen.Color:=Brush.Color;
      Ellipse(Center.X-(XRadius div 3), Center.Y-(YRadius div 3),
              Center.X+(XRadius div 3), Center.Y+(YRadius div 3));
      { Sekunden }
      if FShowSeconds then begin
        Brush.Color:=FColorNumbers;
        Pen.Color:=Brush.Color;
        ElXRadius:=XRadius div 10;
        ElYRadius:=YRadius div 10;
        ElCenter.X:=XKoord(Center.X, (XRadius div 3), 360-(FSecond*6));
        ElCenter.Y:=YKoord(Center.Y, (YRadius div 3), 360-(FSecond*6));
        Ellipse(ElCenter.X-ElXRadius, ElCenter.Y-ElYRadius,
                ElCenter.X+ElXRadius, ElCenter.Y+ElYRadius);
      end;
    end;
    if (FOldWidth<>Self.Width) or (FOldHeight<>Self.Height) then begin
      FOldWidth:=Self.Width;
      FOldHeight:=Self.Height;
    end;
  end;
  Canvas.Draw(0,0,Buffer);
end;

procedure Register;
begin
  RegisterComponents('Simon', [TSRClock]);
end;

end.