| 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.
|
|---|
