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

  1. unit Srclock;
  2.  
  3. { TSRClock (C)opyright 2001 Version 1.40
  4.   Autor : Simon Reinhardt
  5.   eMail : reinhardt@picsoft.de
  6.   Internet : http://www.picsoft.de
  7.  
  8.   Die SRClock-Komponente stellt eine analoge oder digitale Uhr in verschiedenen
  9.   Designs dar und verfⁿgt ⁿber einen Timer, der in einem eigenen Thread lΣuft.
  10.   Die Uhr kann auch als Stopuhr verwendet werden.
  11.  
  12.   Diese Komponenten sind Public Domain, das Urheberrecht liegt aber beim Autor. }
  13.  
  14. interface
  15.  
  16. {$I SRDefine.inc}
  17.  
  18. uses {$IFDEF SR_Win32} Windows, {$ELSE} WinTypes, WinProcs, Menus, {$ENDIF}
  19.   Classes, Controls, Messages, Forms, Graphics, StdCtrls, Grids, SysUtils;
  20.  
  21. type
  22.   TClockStyle = (csClassic, csDigital, csMovingPoints, csPieSlice);
  23.   TClockKind = (ckRealTime, ckStopWatch);
  24.   TContrast = 0..9;
  25.   TNumbers = (snAll, snNone, snQuarters);
  26.   TTime = TDateTime;
  27.  
  28.   TThreadTimer = class;
  29.  
  30.   TTimerThread = class(TThread)
  31.     OwnerTimer: TThreadTimer;
  32.     procedure Execute; override;
  33.   end;
  34.  
  35.   TThreadTimer = class(TComponent)
  36.   private
  37.     FEnabled        : boolean;
  38.     FInterval       : word;
  39.     FOnTimer        : TNotifyEvent;
  40.     FTimerThread    : TTimerThread;
  41.     FThreadPriority : TThreadPriority;
  42.  
  43.     procedure SetEnabled(Value: Boolean);
  44.     procedure SetInterval(Value: word);
  45.     procedure SetThreadPriority(Value: TThreadPriority);
  46.     procedure Timer; dynamic;
  47.  
  48.   protected
  49.     procedure UpdateTimer;
  50.  
  51.   public
  52.     constructor Create(AOwner: TComponent); override;
  53.     destructor Destroy; override;
  54.     property TimerThread: TTimerThread read FTimerThread write FTimerThread;
  55.  
  56.   published
  57.     property Enabled: boolean read FEnabled write SetEnabled default True;
  58.     property Interval: word read FInterval write SetInterval default 250;
  59.     property Priority: TThreadPriority read FThreadPriority write SetThreadPriority default tpNormal;
  60.     property OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
  61.   end;
  62.  
  63.   TSRClock = class(TGraphicControl)
  64.   private
  65.     FAutoUpdate           : boolean;
  66.     FBorderWidth          : integer;
  67.     FColorBackground,
  68.     FColorBorder,
  69.     FColorHands,
  70.     FColorNumbers,
  71.     FColorSegments        : TColor;
  72.     FDigit                : array [0..9] of TBitmap;
  73.     FFadingColor          : boolean;
  74.     FHour,FMinute,FSecond : word;
  75.     FKind                 : TClockKind;
  76.     FLEDContrast          : TContrast;
  77.     FLineWidth            : integer;
  78.     FPriority             : TThreadPriority;
  79.     FOldWidth,FOldHeight  : integer;
  80.     FRunning              : boolean;
  81.     FSegCl                : array [0..9, 1..7] of TColor;
  82.     FShowNumbers          : TNumbers;
  83.     FShowSeconds,
  84.     FShowTicks,
  85.     FSummertime           : boolean;
  86.     FStyle                : TClockStyle;
  87.     FTime                 : TTime;
  88.     FTimeOffset           : double;
  89.     FUpdateInterval       : word;
  90.  
  91.     FOnMouseEnter,
  92.     FOnMouseExit,
  93.     FOnTimer              : TNotifyEvent;
  94.  
  95.     Timer                 : TThreadTimer;
  96.     Buffer                : TBitmap;
  97.  
  98.     function  GetPriority: TThreadPriority;
  99.     procedure SetAutoUpdate(Value: boolean);
  100.     procedure SetBorderWidth(Value: integer);
  101.     procedure SetColorBackground(Value: TColor);
  102.     procedure SetColorBorder(Value: TColor);
  103.     procedure SetColorNumbers(Value: TColor);
  104.     procedure SetColorHands(Value: TColor);
  105.     procedure SetFadingColor(Value: boolean);
  106.     procedure SetKind(Value: TClockKind);
  107.     procedure SetLEDContrast(Value : TContrast);
  108.     procedure SetLineWidth (Value: integer);
  109.     procedure SetPriority(Value: TThreadPriority);
  110.     procedure SetShowNumbers(Value: TNumbers);
  111.     procedure SetShowSeconds(Value: boolean);
  112.     procedure SetShowTicks(Value: boolean);
  113.     procedure SetStyle(Value: TClockStyle);
  114.     procedure SetTime(Value: TTime);
  115.     procedure SetUpdateInterval(Value: word);
  116.  
  117.     procedure AssignColors (seg: integer; s1,s2,s3,s4,s5,s6,s7: Boolean);
  118.     procedure GenerateBitMaps(AWidth, AHeight: integer);
  119.  
  120.   protected
  121.     procedure Paint;  override;
  122.     procedure Loaded; override;
  123.     procedure AutoUpdateClock(Sender: TObject);
  124.     procedure CmEnabledChanged(var Message: TWmNoParams); message CM_ENABLEDCHANGED;
  125.     procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
  126.     procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  127.     procedure CmVisibleChanged(var Message: TWmNoParams); message CM_VISIBLECHANGED;
  128.  
  129.   public
  130.     property Hour: word read FHour;
  131.     property Minute: word read FMinute;
  132.     property Second: word read FSecond;
  133.     property Time: TTime read FTime write SetTime;
  134.     property Summertime: boolean read FSummertime;
  135.  
  136.     procedure Reset;
  137.     procedure Start;
  138.     procedure Stop;
  139.  
  140.     constructor Create(AOwner: TComponent); override;
  141.     destructor Destroy; override;
  142.  
  143.   published
  144.     property Align;
  145.     {$IFDEF SR_Delphi5_Up}
  146.     property Anchors;
  147.     {$ENDIF}
  148.     property AutoUpdate: boolean read FAutoUpdate write SetAutoUpdate;
  149.     property BorderWidth: integer read FBorderWidth write SetBorderWidth;
  150.     property ColorBackground: TColor read FColorBackground write SetColorBackground;
  151.     property ColorBorder: TColor read FColorBorder write SetColorBorder;
  152.     property ColorNumbers: TColor read FColorNumbers write SetColorNumbers;
  153.     property ColorHands: TColor read FColorHands write SetColorHands;
  154.     property DigitLineWidth: integer read FLineWidth write setLineWidth;
  155.     property Enabled;
  156.     property FadingColor: boolean read FFadingColor write SetFadingColor;
  157.     property Font;
  158.     property Kind: TClockKind read FKind write SetKind;
  159.     property LEDContrast: TContrast read FLEDContrast write SetLEDContrast;
  160.     property Priority: TThreadPriority read GetPriority write SetPriority default tpNormal;
  161.     property ShowNumbers: TNumbers read FShowNumbers write SetShowNumbers;
  162.     property ShowSeconds: boolean read FShowSeconds write SetShowSeconds;
  163.     property ShowTicks: boolean read FShowTicks write SetShowTicks;
  164.     property Style: TClockStyle read FStyle write SetStyle;
  165.     property UpdateInterval: word read FUpdateInterval write SetUpdateInterval;
  166.     property Visible;
  167.     property OnClick;
  168.     property OnDblClick;
  169.     property OnDragDrop;
  170.     property OnDragOver;
  171.     property OnEndDrag;
  172.     property OnMouseDown;
  173.     property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
  174.     property OnMouseExit: TNotifyEvent read FOnMouseExit  write FOnMouseExit;
  175.     property OnMouseMove;
  176.     property OnMouseUp;
  177.     property OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
  178.     property OnStartDrag;
  179.   end;
  180.  
  181. procedure Register;
  182.  
  183. implementation
  184.  
  185. uses SRUtils, rrColors;
  186.  
  187. function XKoord(XMittel,XRadius,Grad:word):word;
  188. begin
  189.   Result:=round(XMittel-(sin(Grad*Pi/180)*XRadius));
  190. end; {XKoord}
  191.  
  192. function YKoord(YMittel,YRadius,Grad:word):word;
  193. begin
  194.   Result:=round(YMittel-(cos(Grad*Pi/180)*YRadius));
  195. end; {YKoord}
  196.  
  197. function CalcShadowedColors(AColor:TColor;AContrast:integer):TColor;
  198. var Dummy : TColor;
  199. begin
  200.   Get3DColors(AColor,Dummy,REsult,(10-AContrast)/10,(10-AContrast)/10);
  201. end;
  202.  
  203. { Klasse TThreadTimer }
  204. procedure TTimerThread.Execute;
  205. begin
  206.   Priority := OwnerTimer.Priority;
  207.   repeat
  208.     SleepEx(OwnerTimer.Interval, False);
  209.     Synchronize(OwnerTimer.Timer);
  210.   until Terminated;
  211. end;
  212.  
  213. procedure TThreadTimer.UpdateTimer;
  214. begin
  215.   if not TimerThread.Suspended then
  216.     TimerThread.Suspend;
  217.   if (FInterval <> 0) and FEnabled then
  218.     if TimerThread.Suspended then
  219.       TimerThread.Resume;
  220. end;
  221.  
  222. procedure TThreadTimer.SetEnabled(Value: boolean);
  223. begin
  224.   if Value<>FEnabled then begin
  225.     FEnabled:=Value;
  226.     UpdateTimer;
  227.   end;
  228. end;
  229.  
  230. procedure TThreadTimer.SetInterval(Value: Word);
  231. begin
  232.   if Value<>FInterval then begin
  233.     FInterval:=Value;
  234.     UpdateTimer;
  235.   end;
  236. end;
  237.  
  238. procedure TThreadTimer.SetThreadPriority(Value: TThreadPriority);
  239. begin
  240.   if Value<>FThreadPriority then begin
  241.     FThreadPriority:=Value;
  242.     UpdateTimer;
  243.   end;
  244. end;
  245.  
  246. procedure TThreadTimer.Timer;
  247. begin
  248.   if Assigned(FOntimer) then
  249.     FOnTimer(Self);
  250. end;
  251.  
  252. constructor TThreadTimer.Create(AOwner: TComponent);
  253. begin
  254.   inherited Create(AOwner);
  255.   FEnabled := True;
  256.   FInterval := 250;
  257.   FThreadPriority := tpNormal;
  258.   FTimerThread := TTimerThread.Create(False);
  259.   FTimerThread.OwnerTimer := Self;
  260. end;
  261.  
  262. destructor TThreadTimer.Destroy;
  263. begin
  264.   FEnabled := False;
  265.   UpdateTimer;
  266.   FTimerThread.Free;
  267.   inherited Destroy;
  268. end;
  269.  
  270. { Komponente TSRClock }
  271.  
  272. procedure TSRClock.AssignColors (seg: integer; s1,s2,s3,s4,s5,s6,s7: Boolean);
  273. begin
  274.   if s1 then
  275.     FSegCl[seg, 1] := FColorNumbers
  276.   else
  277.     FSegCl[seg, 1] := FColorSegments;
  278.   if s2 then
  279.     FSegCl[seg, 2] := FColorNumbers
  280.   else
  281.     FSegCl[seg, 2] := FColorSegments;
  282.   if s3 then
  283.     FSegCl[seg, 3] := FColorNumbers
  284.   else
  285.     FSegCl[seg, 3] := FColorSegments;
  286.   if s4 then
  287.     FSegCl[seg, 4] := FColorNumbers
  288.   else
  289.     FSegCl[seg, 4] := FColorSegments;
  290.   if s5 then
  291.     FSegCl[seg, 5] := FColorNumbers
  292.   else
  293.     FSegCl[seg, 5] := FColorSegments;
  294.   if s6 then
  295.     FSegCl[seg, 6] := FColorNumbers
  296.   else
  297.     FSegCl[seg, 6] := FColorSegments;
  298.   if s7 then
  299.     FSegCl[seg, 7] := FColorNumbers
  300.   else
  301.     FSegCl[seg, 7] := FColorSegments;
  302. end;
  303.  
  304. procedure TSRClock.GenerateBitMaps(AWidth, AHeight: integer);
  305. var
  306.   TL, TR, TBL, TBR,
  307.   ML, MTL, MTR, MR,
  308.   MBL, MBR, BL, BTL,
  309.   BTR, BR            : TPoint;
  310.   c, wAlt, LineW,
  311.   DigitW             : integer;
  312. begin
  313.   LineW:=FLineWidth+2;
  314.   DigitW:=round((AWidth-12)/8);
  315.   wAlt := AHeight-4;
  316.   { Polygonpunkte zuweisen }
  317.   TL.x := 0;
  318.   TL.y := 0;
  319.   TR.x := DigitW-1;
  320.   TR.y := 0;
  321.   TBL.x := LineW - 1;
  322.   TBL.y := LineW -1;
  323.   TBR.x := DigitW - LineW;
  324.   TBR.y := TBL.y;
  325.   ML.x := 0;
  326.   ML.y := wAlt div 2;
  327.   MTL.x := TBL.x;
  328.   MTL.y := ML.y - (LineW div 2);
  329.   MTR.x := TBR.x;
  330.   MTR.y := MTL.y;
  331.   MR.x := TR.x;
  332.   MR.y := ML.y;
  333.   MBL.x := TBL.x;
  334.   MBL.y := ML.y + (LineW div 2);
  335.   MBR.x := MTR.x; MBR.y := MBL.y;
  336.   BL.x := 0;
  337.   BL.y := wAlt - 1;
  338.   BR.x := TR.x;
  339.   BR.y := BL.y;
  340.   BTL.x := TBL.x;
  341.   BTL.y := wAlt - LineW;
  342.   BTR.x := TBR.x;
  343.   BTR.y := BTL.y;
  344.  
  345.   { Segmentfarben zuweisen }
  346.   AssignColors (0,true,true,true,false,true,true,true);
  347.   AssignColors (1,false,false,true,false,false,true,false);
  348.   AssignColors (2,true,false,true,true,true,false,true);
  349.   AssignColors (3,true,false,true,true,false,true,true);
  350.   AssignColors (4,false,true,true,true,false,true,false);
  351.   AssignColors (5,true,true,false,true,false,true,true);
  352.   AssignColors (6,false,true,false,true,true,true,true);
  353.   AssignColors (7,true,false,true,false,false,true,false);
  354.   AssignColors (8,true,true,true,true,true,true,true);
  355.   AssignColors (9,true,true,true,true,false,true,true);
  356.  
  357.   { Bitmap erstellen }
  358.   for c := 0 to 9 do begin
  359.     FDigit[c].free;
  360.     FDigit[c] := TBitmap.create;
  361.     FDigit[c].width := DigitW;
  362.     FDigit[c].height := wAlt;
  363.     with FDigit[c].canvas do begin
  364.       Pen.Color := ColorBorder;
  365.       Brush.Color := FColorBackGround;
  366.       Brush.style := bsSolid;
  367.       Pen.Width := 1;
  368.       Rectangle (TL.x, TL.y, BR.x+1, BR.y+1);
  369.       { Segment 1 }
  370.       Brush.Color := FSegCl[c, 1];
  371.       Polygon ([TL, TR, TBR, TBL]);
  372.       { Segment 2 }
  373.       Brush.Color := FSegCl[c, 2];
  374.       Polygon ([TL, TBL, MTL, ML]);
  375.       { Segment 3 }
  376.       Brush.Color := FSegCl[c, 3];
  377.       Polygon ([TR, MR, MTR, TBR]);
  378.       { Segment 4 }
  379.       Brush.Color := FSegCl[c, 4];
  380.       Polygon ([ML, MTL, MTR, MR, MBR, MBL]);
  381.       { Segment 5 }
  382.       Brush.Color := FSegCl[c, 5];
  383.       Polygon ([ML, MBL, BTL, BL]);
  384.       { Segment 6 }
  385.       Brush.Color := FSegCl[c, 6];
  386.       Polygon ([MR, BR, BTR, MBR]);
  387.       { Segment 7 }
  388.       Brush.Color := FSegCl[c, 7];
  389.       Polygon ([BL, BTL, BTR, BR]);
  390.     end;
  391.   end;
  392. end;
  393.  
  394. constructor TSRClock.Create(AOwner: TComponent);
  395. var msec : word;
  396. begin
  397.   inherited Create(AOwner);
  398.   {  defaults  }
  399.   Buffer := TBitmap.Create;
  400.  
  401.   FUpdateInterval:=1000;
  402.   Timer := TThreadTimer.Create(self);
  403.   Timer.Interval := FUpdateInterval;
  404.   Timer.OnTimer := AutoUpdateClock;
  405.  
  406.   FTime:=Now;
  407.   try
  408.     DecodeTime(FTime,FHour,FMinute,FSecond,msec);
  409.   except
  410.   end;
  411.  
  412.   FAutoUpdate:=false;
  413.   FBorderWidth:=2;
  414.   FColorBackGround:=clWindow;
  415.   FColorBorder:=clWindowFrame;
  416.   FColorNumbers:=clBlue;
  417.   FLEDContrast:=6;
  418.   FColorSegments:=CalcShadowedColors(FColorNumbers, FLEDContrast);
  419.   FColorHands:=clNavy;
  420.   FLineWidth:= 3;
  421.   FPriority := tpNormal;
  422.   FRunning:=false;
  423.   FShowNumbers:=snQuarters;
  424.   FShowSeconds:=true;
  425.   FShowTicks:=true;
  426.   FSummertime:=IsSummertime(Now);
  427.   FStyle:=csClassic;
  428.  
  429.   SetBounds(0,0,80,80);
  430.  
  431.   FOldWidth:=Self.Width;
  432.   FOldHeight:=Self.Height;
  433.   if FStyle=csDigital then
  434.     GenerateBitMaps(Self.Width, Self.Height);
  435. end;
  436.  
  437. destructor TSRClock.Destroy;
  438. begin
  439.   Buffer.Free;
  440.   Timer.Free;
  441.   inherited Destroy;
  442. end;
  443.  
  444. procedure TSRClock.Loaded;
  445. begin
  446.   inherited Loaded;
  447.   Buffer.Width := Self.ClientWidth;
  448.   Buffer.Height := Self.ClientHeight;
  449.   Buffer.Canvas.Brush.Color := Color;
  450. end;
  451.  
  452. procedure TSRClock.CmEnabledChanged(var Message: TWmNoParams);
  453. begin
  454.   inherited;
  455.   Timer.Enabled := Self.Enabled;
  456.   Invalidate;
  457. end;
  458.  
  459. procedure TSRClock.CMMouseEnter(var Message: TMessage);
  460. begin
  461.   inherited;
  462.   if Assigned(FOnMouseEnter) then
  463.     FOnMouseEnter(Self);
  464. end;
  465.  
  466. procedure TSRClock.CMMouseLeave(var Message: TMessage);
  467. begin
  468.   inherited;
  469.   if Assigned(FOnMouseExit) then
  470.     FOnMouseExit(Self);
  471. end;
  472.  
  473. procedure TSRClock.CmVisibleChanged(var Message: TWmNoParams);
  474. begin
  475.   inherited;
  476.   Invalidate;
  477. end;
  478.  
  479. function TSRClock.GetPriority: TThreadPriority;
  480. begin
  481.   Result := Timer.Priority;
  482. end;
  483.  
  484. procedure TSRClock.SetAutoUpdate(Value: boolean);
  485. begin
  486.   if (FAutoUpdate<>Value) and (FKind=ckRealTime) then begin
  487.     FAutoUpdate:=Value;
  488.     Timer.Enabled := FAutoUpdate;
  489.   end;
  490. end;
  491.  
  492. procedure TSRClock.SetBorderWidth(Value: integer);
  493. begin
  494.   if Value<>FBorderWidth then begin
  495.     FBorderWidth:=Value;
  496.     if FStyle=csDigital then
  497.       GenerateBitMaps(Self.Width, Self.Height);
  498.     Invalidate;
  499.   end;
  500. end;
  501.  
  502. procedure TSRClock.SetColorBackground(Value: TColor);
  503. begin
  504.   if Value<>FColorBackground then begin
  505.     FColorBackground:=Value;
  506.     if FStyle=csDigital then
  507.       GenerateBitMaps(Self.Width, Self.Height);
  508.     Invalidate;
  509.   end;
  510. end;
  511.  
  512. procedure TSRClock.SetColorBorder(Value: TColor);
  513. begin
  514.   if Value<>FColorBorder then begin
  515.     FColorBorder:=Value;
  516.     Invalidate;
  517.   end;
  518. end;
  519.  
  520. procedure TSRClock.SetColorNumbers(Value: TColor);
  521. begin
  522.   if Value<>FColorNumbers then begin
  523.     FColorNumbers:=Value;
  524.     FColorSegments:=CalcShadowedColors(FColorNumbers, FLEDContrast);
  525.     if FStyle=csDigital then
  526.       GenerateBitMaps(Self.Width, Self.Height);
  527.     Invalidate;
  528.   end;
  529. end;
  530.  
  531. procedure TSRClock.SetColorHands(Value: TColor);
  532. begin
  533.   if Value<>FColorHands then begin
  534.     FColorHands:=Value;
  535.     Invalidate;
  536.   end;
  537. end;
  538.  
  539. procedure TSRClock.SetFadingColor(Value: boolean);
  540. begin
  541.   if Value<>FFadingColor then begin
  542.     FFadingColor:=Value;
  543.     Invalidate;
  544.   end;
  545. end;
  546.  
  547. procedure TSRClock.SetKind(Value: TClockKind);
  548. begin
  549.   if Value<>FKind then begin
  550.     FKind:=Value;
  551.     if FKind=ckRealTime then
  552.       FTime:=Now
  553.     else begin
  554.       FRunning:=false;
  555.       FTimeOffset:=Now;
  556.       FTime:=0;
  557.     end;
  558.     Invalidate;
  559.   end;
  560. end;
  561.  
  562. procedure TSRClock.SetLEDContrast(Value: TContrast);
  563. begin
  564.   if (FLEDContrast<>Value) and (Value>=0) and (Value<10) then begin
  565.     FLEDContrast:=Value;
  566.     FColorSegments:=CalcShadowedColors(FColorNumbers, FLEDContrast);
  567.     if FStyle=csDigital then
  568.       GenerateBitMaps(Self.Width, Self.Height);
  569.     Invalidate;
  570.   end;
  571. end;
  572.  
  573. procedure TSRClock.SetLineWidth (Value: integer);
  574. begin
  575.   if FLineWidth<>Value then begin
  576.     FLineWidth:=Value;
  577.     if FStyle=csDigital then
  578.       GenerateBitMaps(Self.Width, Self.Height);
  579.     Invalidate;
  580.   end;
  581. end;
  582.  
  583. procedure TSRClock.SetPriority(Value: TThreadPriority);
  584. begin
  585.   if Value<>FPriority then begin
  586.     FPriority:=Value;
  587.     Timer.Priority := FPriority;
  588.   end;
  589. end;
  590.  
  591. procedure TSRClock.SetShowNumbers(Value: TNumbers);
  592. begin
  593.   if Value<>FShowNumbers then begin
  594.     FShowNumbers:=Value;
  595.     Invalidate;
  596.   end;
  597. end;
  598.  
  599. procedure TSRClock.SetShowSeconds(Value: boolean);
  600. begin
  601.   if Value<>FShowSeconds then begin
  602.     FShowSeconds:=Value;
  603.     Invalidate;
  604.   end;
  605. end;
  606.  
  607. procedure TSRClock.SetShowTicks(Value: boolean);
  608. begin
  609.   if Value<>FShowTicks then begin
  610.     FShowTicks:=Value;
  611.     Invalidate;
  612.   end;
  613. end;
  614.  
  615. procedure TSRClock.SetStyle(Value: TClockStyle);
  616. begin
  617.   if Value<>FStyle then begin
  618.     FStyle:=Value;
  619.     if FStyle=csDigital then
  620.       GenerateBitMaps(Self.Width, Self.Height);
  621.     Invalidate;
  622.   end;
  623. end;
  624.  
  625. procedure TSRClock.SetTime(Value: TTime);
  626. var msec : word;
  627. begin
  628.   if Value<>FTime then begin
  629.     FTime:=Value;
  630.     try
  631.       DecodeTime(FTime,FHour,FMinute,FSecond,msec);
  632.     except
  633.       FHour:=0;
  634.       FMinute:=0;
  635.       FSecond:=0;
  636.     end;
  637.     Paint;
  638.   end;
  639. end;
  640.  
  641. procedure TSRClock.SetUpdateInterval(Value: word);
  642. begin
  643.   if Value<>FUpdateInterval then begin
  644.     FUpdateInterval:=Value;
  645.     Timer.Interval:=FUpdateInterval;
  646.     Invalidate;
  647.   end;
  648. end;
  649.  
  650. procedure TSRClock.AutoUpdateClock(Sender: TObject);
  651. begin
  652.   if ((Kind=ckRealTime) and FAutoUpdate) or ((Kind=ckStopWatch) and FRunning) then begin
  653.     if Kind=ckStopWatch then
  654.       SetTime(Now-FTimeOffset)
  655.     else
  656.       SetTime(Now);
  657.     if Assigned(FOnTimer) then
  658.       FOnTimer(Self);
  659.   end;
  660. end;
  661.  
  662. procedure TSRClock.Reset;
  663. begin
  664.   FTimeOffset:=Now;
  665.   FTime:=0;
  666.   Invalidate;
  667. end;
  668.  
  669. procedure TSRClock.Start;
  670. begin
  671.   FTimeOffset:=Now-FTime;
  672.   FRunning:=true;
  673. end;
  674.  
  675. procedure TSRClock.Stop;
  676. begin
  677.   FRunning:=false;
  678. end;
  679.  
  680. procedure TSRClock.Paint;
  681. var ARect       : TRect;
  682.     Center,
  683.     ElCenter    : TPoint;
  684.     i           : byte;
  685.     XRadius,
  686.     YRadius,
  687.     ElXRadius,
  688.     ElYRadius,
  689.     Grad        : word;
  690.     anchoPosi,
  691.     posiLeft,
  692.     PosiTop, c,
  693.     SepPosition : integer;
  694.     outText     : string;
  695.     ElXAbstand,
  696.     ElYAbstand  : double;
  697.  
  698.   procedure AlTextOut(X,Y:integer;Text:string;HAlign,VAlign:TAlignment);
  699.   var LeftOut,TopOut : integer;
  700.   begin
  701.     with Buffer.Canvas do begin
  702.       LeftOut:=X;
  703.       if HAlign=taRightJustify then
  704.         LeftOut:=X-TextWidth(Text);
  705.       if HAlign=taCenter then
  706.         LeftOut:=X-(TextWidth(Text) div 2);
  707.       TopOut:=Y;
  708.       if VAlign=taRightJustify then
  709.         TopOut:=Y-TextHeight(Text);
  710.       if VAlign=taCenter then
  711.         TopOut:=Y-(TextHeight(Text) div 2);
  712.       TextOut(LeftOut,TopOut,Text);
  713.     end;
  714.   end; { AlTextOut }
  715.  
  716. begin
  717.   Buffer.Width := Self.Width;
  718.   Buffer.Height := Self.Height;
  719.   ARect:=GetClientRect;
  720.   Center.X:=(ARect.Right-ARect.Left) div 2;
  721.   Center.Y:=(ARect.Bottom-ARect.Top) div 2;
  722.   with Buffer.Canvas do begin
  723.     Font.Assign(Self.Font);
  724.     Brush.Color := Self.Color;
  725.     Brush.Style := bsSolid;
  726.     Pen.Color := Self.Color;
  727.     Rectangle(0, 0, Width, Height);
  728.  
  729.     if Style=csDigital then begin
  730.       if (FOldWidth<>Self.Width) or (FOldHeight<>Self.Height) then
  731.         GenerateBitmaps(Self.Width, Self.Height);
  732.       Brush.Color := ColorBackground;
  733.       Pen.Color := ColorBorder;
  734.       Rectangle(0, 0, Width, Height);
  735.       try
  736.         outText:=FormatDateTime('hh:mm:ss', FTime);
  737.       except
  738.         outText:='';
  739.       end;
  740.       anchoPosi := round((Self.Width-4)/8);
  741.       PosiTop := (Self.Height - (Self.Height-4)) div 2;
  742.       posiLeft := ((anchoPosi - round((Self.Width)/8)) div 2)+3;
  743.       Brush.Color := FColorNumbers;
  744.       Pen.Color := FColorNumbers;
  745.       { Bitmaps und DecSeperator zeichnen }
  746.       for c := 1 to 8 do begin
  747.         { nachfolgende Nullen mⁿssen gezeichnet werden! }
  748.         if outText[c]=':' then begin
  749.           Pen.Width:=1;
  750.           Ellipse(posiLeft+round((Width-12)/16), posiTop+((Height-4) div 3)-2,
  751.                   posiLeft+FLineWidth+round((Width-12)/16), posiTop+((Height-4) div 3)-2+FLineWidth);
  752.           Ellipse(posiLeft+round((Width-12)/16), posiTop+((Height-4)*2 div 3)-2,
  753.                   posiLeft+FLineWidth+round((Width-12)/16), posiTop+((Height-4)*2 div 3)-2+FLineWidth);
  754.         end
  755.         else
  756.           Draw (posiLeft, posiTop, FDigit[strToInt(outText[c])]);
  757.         inc (posiLeft, anchoPosi);
  758.       end;
  759.     end
  760.     else begin
  761.       { Rahmen und Hintergrund: }
  762.       Pen.Width:=FBorderWidth;
  763.       Pen.Color:=FColorBorder;
  764.       Brush.Color:=FColorBackground;
  765.       Brush.Style:=bsSolid;
  766.       InflateRect(ARect, -FBorderWidth div 2, -FBorderWidth div 2);
  767.       Ellipse(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
  768.       Pen.Width:=1;
  769.     end;
  770.     XRadius:=(ARect.Right-ARect.Left) div 2;
  771.     YRadius:=(ARect.Bottom-ARect.Top) div 2;
  772.     if Style=csClassic then begin
  773.       { Markierungen: }
  774.       if FShowTicks then begin
  775.         for i:=1 to 12 do begin
  776.           MoveTo(XKoord(Center.X-1, XRadius-1, 360-(i*30)),
  777.                  YKoord(Center.Y-1, YRadius-1, 360-(i*30)));
  778.           LineTo(XKoord(Center.X-1, XRadius-5, 360-(i*30)),
  779.                  YKoord(Center.Y-1, YRadius-5, 360-(i*30)));
  780.         end;
  781.       end;
  782.  
  783.       { Ziffern: }
  784.       if FShowNumbers<>snNone then begin
  785.         Brush.Style:=bsClear;
  786.         Font.Color:=FColorNumbers;
  787.         for i:=1 to 12 do
  788.           if (FShowNumbers=snAll) or ((FShowNumbers=snQuarters) and ((i mod 3)=0)) then
  789.             AlTextOut(XKoord(Center.X, XRadius-TextWidth('3')-2, 360-(i*30)),
  790.                       YKoord(Center.Y, YRadius-(TextHeight('1') div 2)-4, 360-(i*30)),
  791.                       IntToStr(i), taCenter, taCenter);
  792.       end;
  793.  
  794.       { Zeiger: }
  795.       Pen.Color:=FColorBorder;
  796.       Brush.Color:=FColorBorder;
  797.       Brush.Style:=bsSolid;
  798.       Ellipse(Center.X-(XRadius div 10), Center.Y-(YRadius div 10),
  799.               Center.X+(XRadius div 10), Center.Y+(YRadius div 10));
  800.       Pen.Color:=FColorHands;
  801.       { Stunden }
  802.       Pen.Width:=4;
  803.       Grad:=360-((FHour mod 12)*30);
  804.       Grad:=Grad-round(30*(FMinute/60));
  805.       MoveTo(Center.X, Center.Y);
  806.       LineTo(XKoord(Center.X,XRadius div 2,Grad),
  807.              YKoord(Center.Y,YRadius div 2,Grad));
  808.       { Minuten }
  809.       Pen.Width:=2;
  810.       MoveTo(Center.X, Center.Y);
  811.       LineTo(XKoord(Center.X,XRadius-4,360-(FMinute*6)),
  812.              YKoord(Center.Y,YRadius-4,360-(FMinute*6)));
  813.       { Sekunden }
  814.       if FShowSeconds then begin
  815.         Pen.Width:=1;
  816.         Pen.Color:=FColorNumbers;
  817.         MoveTo(XKoord(Center.X,5,180-(FSecond*6)),
  818.                YKoord(Center.Y,5,180-(FSecond*6)));
  819.         LineTo(XKoord(Center.X,XRadius-4,360-(FSecond*6)),
  820.                YKoord(Center.Y,YRadius-4,360-(FSecond*6)));
  821.       end;
  822.     end;
  823.     if Style=csMovingPoints then begin
  824.       Brush.Color:=FColorBorder;
  825.       Brush.Style:=bsSolid;
  826.       ElXRadius:=((XRadius-(XRadius div 5)) div 2)-2;
  827.       ElYRadius:=((YRadius-(YRadius div 5)) div 2)-2;
  828.       Ellipse(Center.X-ElXRadius, Center.Y-ElYRadius,
  829.               Center.X+ElXRadius, Center.Y+ElYRadius);
  830.       { Stunden und Minuten }
  831.       if (FMinute=0) or not FFadingColor then
  832.         Brush.Color:=FColorHands
  833.       else
  834.         Brush.Color:=CalcShadowedColors(FColorHands, round(7-(7/(60-FMinute))));
  835.       Pen.Color:=Brush.Color;
  836.       Grad:=360-((FHour mod 12)*30);
  837.       Grad:=Grad-round(30*(FMinute/60));
  838.       ElXRadius:=XRadius div 5;
  839.       ElYRadius:=YRadius div 5;
  840.       ElXAbstand:=(XRadius-ElXRadius)/120;
  841.       ElYAbstand:=(YRadius-ElYRadius)/120;
  842.       if FMinute=0 then begin
  843.         ElCenter.X:=XKoord(Center.X, XRadius-2, Grad);
  844.         ElCenter.Y:=YKoord(Center.Y, YRadius-2, Grad);
  845.       end
  846.       else begin
  847.         ElCenter.X:=XKoord(Center.X, XRadius-2-round((60-FMinute)*ElXAbstand), Grad);
  848.         ElCenter.Y:=YKoord(Center.Y, YRadius-2-round((60-FMinute)*ElYAbstand), Grad);
  849.       end;
  850.       Pie(ElCenter.X-ElXRadius, ElCenter.Y-ElYRadius,
  851.           ElCenter.X+ElXRadius, ElCenter.Y+ElYRadius,
  852.           XKoord(ElCenter.X, ElXRadius, Grad+135), YKoord(ElCenter.Y, ElYRadius, Grad+135),
  853.           XKoord(ElCenter.X, ElXRadius, Grad-135), YKoord(ElCenter.Y, ElYRadius, Grad-135));
  854.       { Sekunden }
  855.       if FShowSeconds then begin
  856.         Brush.Color:=FColorNumbers;
  857.         Pen.Color:=Brush.Color;
  858.         ElXRadius:=ElXRadius div 3;
  859.         ElYRadius:=ElYRadius div 3;
  860.         ElCenter.X:=XKoord(Center.X, (XRadius div 3), 360-(FSecond*6));
  861.         ElCenter.Y:=YKoord(Center.Y, (YRadius div 3), 360-(FSecond*6));
  862.         Ellipse(ElCenter.X-ElXRadius, ElCenter.Y-ElYRadius,
  863.                 ElCenter.X+ElXRadius, ElCenter.Y+ElYRadius);
  864.       end;
  865.     end;
  866.     if Style=csPieSlice then begin
  867.       if (FMinute=0) or not FFadingColor then
  868.         Brush.Color:=FColorHands
  869.       else
  870.         Brush.Color:=CalcShadowedColors(FColorHands, round(7-(7/(60-FMinute))));
  871.       Pen.Color:=Brush.Color;
  872.       { Stunden und Minuten }
  873.       ElXAbstand:=(XRadius-(XRadius div 3)-4)/60;
  874.       ElYAbstand:=(YRadius-(YRadius div 3)-4)/60;
  875.       if FMinute=0 then begin
  876.         ElXRadius:=(XRadius div 3)+round(ElXAbstand*60);
  877.         ElYRadius:=(YRadius div 3)+round(ElYAbstand*60);
  878.       end
  879.       else begin
  880.         ElXRadius:=(XRadius div 3)+round(ElXAbstand*FMinute);
  881.         ElYRadius:=(YRadius div 3)+round(ElYAbstand*FMinute);
  882.       end;
  883.       Grad:=360-((FHour mod 12)*30);
  884.       Grad:=Grad-round(30*(FMinute/60));
  885.       Pie(Center.X-ElXRadius, Center.Y-ElYRadius,
  886.           Center.X+ElXRadius, Center.Y+ElYRadius,
  887.           XKoord(Center.X, ElXRadius, Grad), YKoord(Center.Y, ElYRadius, Grad),
  888.           XKoord(Center.X, ElXRadius, 0), YKoord(Center.Y, ElYRadius, 0));
  889.       Brush.Color:=FColorBorder;
  890.       Brush.Style:=bsSolid;
  891.       Pen.Color:=Brush.Color;
  892.       Ellipse(Center.X-(XRadius div 3), Center.Y-(YRadius div 3),
  893.               Center.X+(XRadius div 3), Center.Y+(YRadius div 3));
  894.       { Sekunden }
  895.       if FShowSeconds then begin
  896.         Brush.Color:=FColorNumbers;
  897.         Pen.Color:=Brush.Color;
  898.         ElXRadius:=XRadius div 10;
  899.         ElYRadius:=YRadius div 10;
  900.         ElCenter.X:=XKoord(Center.X, (XRadius div 3), 360-(FSecond*6));
  901.         ElCenter.Y:=YKoord(Center.Y, (YRadius div 3), 360-(FSecond*6));
  902.         Ellipse(ElCenter.X-ElXRadius, ElCenter.Y-ElYRadius,
  903.                 ElCenter.X+ElXRadius, ElCenter.Y+ElYRadius);
  904.       end;
  905.     end;
  906.     if (FOldWidth<>Self.Width) or (FOldHeight<>Self.Height) then begin
  907.       FOldWidth:=Self.Width;
  908.       FOldHeight:=Self.Height;
  909.     end;
  910.   end;
  911.   Canvas.Draw(0,0,Buffer);
  912. end;
  913.  
  914. procedure Register;
  915. begin
  916.   RegisterComponents('Simon', [TSRClock]);
  917. end;
  918.  
  919. end.
  920.