home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / sibdemo3.zip / SOURCE.DAT / SOURCE / ADDON / CLOCKS.PAS < prev    next >
Pascal/Delphi Source File  |  1998-05-02  |  8KB  |  249 lines
  1. UNIT Clocks;
  2.  
  3. INTERFACE
  4.  
  5. USES Dos,Classes,Forms;
  6.  
  7. TYPE TAnalogClock=CLASS(TControl)
  8.         PRIVATE
  9.               FVertRes,FHorzRes:LONGINT;
  10.               FCXPixel,FCYPixel:LONGINT;
  11.               FHour,FMinute,FSecond,FSec100:WORD;
  12.               FTimer:TTimer;
  13.               FHourColor,FMinuteColor,FSecondColor:TColor;
  14.               PROCEDURE MakePoints(VAR pts:ARRAY OF TPoint;Count,Angle:LONGINT);
  15.               PROCEDURE DrawHand(pts:ARRAY OF TPoint;Value:WORD);
  16.               PROPERTY Caption;
  17.               PROPERTY Font;
  18.         PROTECTED
  19.               PROCEDURE SetupComponent;OVERRIDE;
  20.               PROCEDURE SetupShow;OVERRIDE;
  21.               PROCEDURE Resize;OVERRIDE;
  22.               PROCEDURE TimerEvent(Sender:TObject);
  23.         PUBLIC
  24.               DESTRUCTOR Destroy;OVERRIDE;
  25.               PROCEDURE Redraw(CONST rec:TRect);OVERRIDE;
  26.         PUBLISHED
  27.               PROPERTY Align;
  28.               PROPERTY Color;
  29.               PROPERTY PenColor;
  30.               PROPERTY DragCursor;
  31.               PROPERTY DragMode;
  32.               PROPERTY ParentColor;
  33.               PROPERTY ParentPenColor;
  34.               PROPERTY ParentShowHint;
  35.               PROPERTY ShowHint;
  36.               PROPERTY Visible;
  37.               PROPERTY ZOrder;
  38.  
  39.               PROPERTY OnCanDrag;
  40.               PROPERTY OnDragDrop;
  41.               PROPERTY OnDragOver;
  42.               PROPERTY OnEndDrag;
  43.               PROPERTY OnEnter;
  44.               PROPERTY OnExit;
  45.               PROPERTY OnMouseClick;
  46.               PROPERTY OnMouseDblClick;
  47.               PROPERTY OnMouseDown;
  48.               PROPERTY OnMouseMove;
  49.               PROPERTY OnMouseUp;
  50.               PROPERTY OnResize;
  51.               PROPERTY OnSetupShow;
  52.               PROPERTY OnStartDrag;
  53.               PROPERTY HourColor:TColor read FHourColor write FHourColor;
  54.               PROPERTY MinuteColor:TColor read FMinuteColor write FMinuteColor;
  55.               PROPERTY SecondColor:TColor read FSecondColor write FSecondColor;
  56.      END;
  57.  
  58. IMPLEMENTATION
  59.  
  60. {
  61. ╔═══════════════════════════════════════════════════════════════════════════╗
  62. ║                                                                           ║
  63. ║ Speed-Pascal/2 Version 2.0                                                ║
  64. ║                                                                           ║
  65. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  66. ║                                                                           ║
  67. ║ This section: TAnalogClock Class implementation                           ║
  68. ║                                                                           ║
  69. ║ Last modified: September 1995                                             ║
  70. ║                                                                           ║
  71. ║ (C) 1995 SpeedSoft. All rights reserved. Disclosure probibited !          ║
  72. ║                                                                           ║
  73. ╚═══════════════════════════════════════════════════════════════════════════╝
  74. }
  75.  
  76. CONST aptlHour:ARRAY[0..4] OF TPoint=((X:0;Y:-15),(x:7;y:0),(x:0;y:60),
  77.                                       (x:-7;y:0),(x:0;y:-15));
  78.       aptlMinute:ARRAY[0..4] OF TPoint=((X:0;Y:-20),(X:5;Y:0),(X:0;Y:80),
  79.                                         (X:-5;Y:0),(X:0;Y:-20));
  80.       aptlSecond:ARRAY[0..1] OF TPoint=((X:0;Y:0),(X:0;Y:80));
  81.  
  82. PROCEDURE TAnalogClock.SetupComponent;
  83. BEGIN
  84.      Inherited SetupComponent;
  85.  
  86.      Name := 'AnalogClock';
  87.      FTimer.Create(SELF);
  88.      Include(FTimer.ComponentState,csDetail);
  89.      FTimer.Interval:=1000;
  90.      Color:=clBlack;
  91.      FHourColor:=clBlack;
  92.      FMinuteColor:=clBlack;
  93.      FSecondColor:=clBlack;
  94.      ParentColor:=TRUE;
  95.      Width:=150;
  96.      Height:=150;
  97. END;
  98.  
  99. DESTRUCTOR TAnalogClock.Destroy;
  100. BEGIN
  101.      FTimer.Destroy;
  102.      FTimer:=NIL;
  103.      Inherited Destroy;
  104. END;
  105.  
  106. PROCEDURE TAnalogClock.TimerEvent(Sender:TObject);
  107. VAR Hour,Minute,Second,Sec100:WORD;
  108. BEGIN
  109.      IF Handle=0 THEN exit;
  110.  
  111.      IF TTimer(Sender)=FTimer THEN
  112.      BEGIN
  113.           GetTime(Hour,Minute,Second,Sec100);
  114.           Hour:=((Hour*5) MOD 60) + Minute DIV 12;
  115.  
  116.           Canvas.ClipRect:=ClientRect;
  117.  
  118.           Canvas.Pen.Color:=HourColor;
  119.           DrawHand(aptlHour,Hour);
  120.           Canvas.Pen.Color:=MinuteColor;
  121.           DrawHand(aptlMinute,Minute);
  122.           Canvas.Pen.Color:=SecondColor;
  123.           DrawHand(aptlSecond,Second);
  124.  
  125.           Canvas.Pen.Color:=Color;
  126.  
  127.           DrawHand(aptlSecond,FSecond);
  128.           IF ((Hour<>FHour)OR(Minute<>FMinute)) THEN
  129.           BEGIN
  130.                DrawHand(aptlHour,FHour);
  131.                DrawHand(aptlMinute,FMinute);
  132.           END;
  133.  
  134.           Canvas.DeleteClipRegion;
  135.  
  136.           FHour:=Hour;
  137.           FMinute:=Minute;
  138.           FSecond:=Second;
  139.           FSec100:=Sec100;
  140.      END;
  141. END;
  142.  
  143. PROCEDURE TAnalogClock.SetupShow;
  144. BEGIN
  145.      Inherited SetupShow;
  146.  
  147.      FVertRes:=Canvas.VerticalResolution;
  148.      FHorzRes:=Canvas.HorizontalResolution;
  149.      Resize;
  150.      GetTime(FHour,FMinute,FSecond,FSec100);
  151.      FHour:=(FHour*5) MOD 60 + FMinute DIV 12;
  152.      FTimer.OnTimer:=TimerEvent;
  153.      FTimer.Start;
  154. END;
  155.  
  156. PROCEDURE TAnalogClock.Resize;
  157. VAR Temp:LONGINT;
  158.     CX,CY:LONGINT;
  159. BEGIN
  160.      Inherited Resize;
  161.  
  162.      CX:=Width*1000 DIV FHorzRes;
  163.      CY:=Height*1000 DIV FVertRes;
  164.      IF CX<CY THEN Temp:=CX
  165.      ELSE Temp:=CY;
  166.  
  167.      FCXPixel:=FHorzRes*Temp DIV 1000;
  168.      FCYPixel:=FVertRes*Temp DIV 1000;
  169. END;
  170.  
  171. PROCEDURE TAnalogClock.MakePoints(VAR pts:ARRAY OF TPoint;Count,Angle:LONGINT);
  172. CONST SinTable:ARRAY[0..59] OF LONGINT=
  173.          (
  174.           0,105,208,309,407,500,588,669,743,809,
  175.           866,914,951,978,995,1000,995,978,951,914,
  176.           866,809,743,669,588,500,407,309,208,105,
  177.           0,-104,-207,-308,-406,-499,-587,-668,-742,-808,
  178.           -865,-913,-950,-977,-994,-999,-994,-977,-950,-913,
  179.           -865,-808,-742,-668,-587,-499,-406,-308,-207,-104
  180.          );
  181. VAR t:LONGINT;
  182.     Cos1,Sin1:LONGINT;
  183.     pt:TPoint;
  184. CONST
  185.   Factor: Single = 6 * PI / 180;
  186. BEGIN
  187.      Cos1:=SinTable[(Angle+15) MOD 60];
  188.      Sin1:=SinTable[Angle];
  189.      FOR t:=0 TO Count-1 DO
  190.      BEGIN
  191.           pt:=pts[t];
  192.           pt:=Point((pt.X*Cos1+pt.Y*Sin1) DIV 1000,(pt.Y*Cos1-pt.X*Sin1) DIV 1000);
  193.           pt.X:=((pt.X*FCXPixel) DIV 200);
  194.           inc(pt.x,Width DIV 2);
  195.           pt.Y:=((pt.Y*FCYPixel) DIV 200);
  196.           inc(pt.y,Height DIV 2);
  197.           pts[t]:=pt;
  198.      END;
  199. END;
  200.  
  201. PROCEDURE TAnalogClock.DrawHand(pts:ARRAY OF TPoint;Value:WORD);
  202. VAR t:LONGINT;
  203. BEGIN
  204.      MakePoints(pts,High(pts)+1,Value);
  205.  
  206.      Canvas.BeginPath;
  207.      Canvas.PenPos:=pts[0];
  208.      FOR t:=1 TO High(pts) DO Canvas.LineTo(pts[t].X,pts[t].Y);
  209.      Canvas.EndPath;
  210.      Canvas.FillPath;
  211.  
  212.      Canvas.BeginPath;
  213.      Canvas.PenPos:=pts[0];
  214.      FOR t:=1 TO High(pts) DO Canvas.LineTo(pts[t].X,pts[t].Y);
  215.      Canvas.EndPath;
  216.      Canvas.PathToClipRegion(paDiff);
  217. END;
  218.  
  219. PROCEDURE TAnalogClock.Redraw(CONST rec:TRect);
  220. VAR Angle:LONGINT;
  221.     pt:ARRAY[0..0] OF TPoint;
  222.     Radius:LONGINT;
  223. BEGIN
  224.      Canvas.Pen.Color:=HourColor;
  225.      DrawHand(aptlHour,FHour);
  226.      Canvas.Pen.Color:=MinuteColor;
  227.      DrawHand(aptlMinute,FMinute);
  228.      Canvas.Pen.Color:=SecondColor;
  229.      DrawHand(aptlSecond,FSecond);
  230.  
  231.      Inherited Redraw(rec);
  232.  
  233.      Canvas.Pen.Color:=PenColor;
  234.  
  235.      FOR Angle:=0 TO 59 DO
  236.      BEGIN
  237.           IF Angle MOD 5<>0 THEN Radius:=1
  238.           ELSE Radius:=4;
  239.  
  240.           pt[0]:=Point(0,90);
  241.           MakePoints(pt,1,Angle);
  242.  
  243.           Canvas.FilledCircle(pt[0].X,pt[0].Y,Radius*FCXPixel DIV 200);
  244.      END;
  245. END;
  246.  
  247. BEGIN
  248.      RegisterClasses([TAnalogClock]);
  249. END.