home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d6 / RX275D6.ZIP / Units / RXCLOCK.PAS < prev    next >
Pascal/Delphi Source File  |  2001-06-24  |  29KB  |  947 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 1995, 1996 AO ROSNO             }
  6. {         Copyright (c) 1997, 1998 Master-Bank          }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit RXClock;
  11.  
  12. interface
  13.  
  14. {$I RX.INC}
  15.  
  16.  
  17. uses Windows, SysUtils, Messages, Classes, Graphics, Controls,
  18.     Forms, StdCtrls, ExtCtrls, Menus, RxTimer, RTLConsts;
  19.  
  20. type
  21.   TShowClock = (scDigital, scAnalog);
  22.   TPaintMode = (pmPaintAll, pmHandPaint);
  23.  
  24.   TRxClockTime = packed record
  25.     Hour, Minute, Second: Word;
  26.   end;
  27.  
  28.   TRxGetTimeEvent = procedure (Sender: TObject; var ATime: TDateTime) of object;
  29.  
  30. { TRxClock }
  31.  
  32.   TRxClock = class(TCustomPanel)
  33.   private
  34.     { Private declarations }
  35.     FTimer: TRxTimer;
  36.     FAutoSize: Boolean;
  37.     FShowMode: TShowClock;
  38.     FTwelveHour: Boolean;
  39.     FLeadingZero: Boolean;
  40.     FShowSeconds: Boolean;
  41.     FAlarm: TDateTime;
  42.     FAlarmEnabled: Boolean;
  43.     FHooked: Boolean;
  44.     FDotsColor: TColor;
  45.     FAlarmWait: Boolean;
  46.     FDisplayTime: TRxClockTime;
  47.     FClockRect: TRect;
  48.     FClockRadius: Longint;
  49.     FClockCenter: TPoint;
  50.     FOnGetTime: TRxGetTimeEvent;
  51.     FOnAlarm: TNotifyEvent;
  52.     procedure TimerExpired(Sender: TObject);
  53.     procedure GetTime(var T: TRxClockTime);
  54.     function IsAlarmTime(ATime: TDateTime): Boolean;
  55.     procedure SetShowMode(Value: TShowClock);
  56.     function GetAlarmElement(Index: Integer): Byte;
  57.     procedure SetAlarmElement(Index: Integer; Value: Byte);
  58.     procedure SetAutoSize(Value: Boolean);
  59.     procedure SetDotsColor(Value: TColor);
  60.     procedure SetTwelveHour(Value: Boolean);
  61.     procedure SetLeadingZero(Value: Boolean);
  62.     procedure SetShowSeconds(Value: Boolean);
  63.     procedure PaintAnalogClock(PaintMode: TPaintMode);
  64.     procedure Paint3DFrame(var Rect: TRect);
  65.     procedure DrawAnalogFace;
  66.     procedure CircleClock(MaxWidth, MaxHeight: Integer);
  67.     procedure DrawSecondHand(Pos: Integer);
  68.     procedure DrawFatHand(Pos: Integer; HourHand: Boolean);
  69.     procedure PaintTimeStr(var Rect: TRect; FullTime: Boolean);
  70.     procedure ResizeFont(const Rect: TRect);
  71.     procedure ResetAlarm;
  72.     procedure CheckAlarm;
  73.     function FormatSettingsChange(var Message: TMessage): Boolean;
  74.     procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
  75.     procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
  76.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  77.     procedure WMTimeChange(var Message: TMessage); message WM_TIMECHANGE;
  78.   protected
  79.     { Protected declarations }
  80.     procedure Alarm; dynamic;
  81.     procedure AlignControls(AControl: TControl; var Rect: TRect); override;
  82.     procedure CreateWnd; override;
  83.     procedure DestroyWindowHandle; override;
  84.     procedure Loaded; override;
  85.     procedure Paint; override;
  86.     function GetSystemTime: TDateTime; virtual;
  87.   public
  88.     { Public declarations }
  89.     constructor Create(AOwner: TComponent); override;
  90.     destructor Destroy; override;
  91.     procedure SetAlarmTime(AlarmTime: TDateTime);
  92.     procedure UpdateClock;
  93.   published
  94.     { Published declarations }
  95.     property AlarmEnabled: Boolean read FAlarmEnabled write FAlarmEnabled default False;
  96.     property AlarmHour: Byte Index 1 read GetAlarmElement write SetAlarmElement default 0;
  97.     property AlarmMinute: Byte Index 2 read GetAlarmElement write SetAlarmElement default 0;
  98.     property AlarmSecond: Byte Index 3 read GetAlarmElement write SetAlarmElement default 0;
  99.     property AutoSize: Boolean read FAutoSize write SetAutoSize default False;
  100.     property BevelInner default bvLowered;
  101.     property BevelOuter default bvRaised;
  102.     property DotsColor: TColor read FDotsColor write SetDotsColor default clTeal;
  103.     property ShowMode: TShowClock read FShowMode write SetShowMode default scDigital;
  104.     property ShowSeconds: Boolean read FShowSeconds write SetShowSeconds default True;
  105.     property TwelveHour: Boolean read FTwelveHour write SetTwelveHour default False;
  106.     property LeadingZero: Boolean read FLeadingZero write SetLeadingZero default True;
  107.     property Align;
  108.     property BevelWidth;
  109.     property BorderWidth;
  110.     property BorderStyle;
  111. {$IFDEF RX_D4}
  112.     property Anchors;
  113.     property Constraints;
  114.     property UseDockManager default True;
  115.     property DockSite;
  116.     property DragKind;
  117.     property FullRepaint;
  118. {$ENDIF}
  119.     property Color;
  120.     property Ctl3D;
  121.     property Cursor;
  122.     property DragMode;
  123.     property DragCursor;
  124.     property Enabled;
  125.     property Font;
  126.     property ParentColor;
  127.     property ParentCtl3D;
  128.     property ParentFont;
  129.     property ParentShowHint;
  130.     property PopupMenu;
  131.     property ShowHint;
  132.     property Visible;
  133.     property OnAlarm: TNotifyEvent read FOnAlarm write FOnAlarm;
  134.     property OnGetTime: TRxGetTimeEvent read FOnGetTime write FOnGetTime;
  135.     property OnClick;
  136.     property OnDblClick;
  137.     property OnMouseMove;
  138.     property OnMouseDown;
  139.     property OnMouseUp;
  140.     property OnDragOver;
  141.     property OnDragDrop;
  142.     property OnEndDrag;
  143.     property OnResize;
  144. {$IFDEF RX_D5}
  145.     property OnContextPopup;
  146. {$ENDIF}
  147. {$IFDEF WIN32}
  148.     property OnStartDrag;
  149. {$ENDIF}
  150. {$IFDEF RX_D4}
  151.     property OnCanResize;
  152.     property OnConstrainedResize;
  153.     property OnDockDrop;
  154.     property OnDockOver;
  155.     property OnEndDock;
  156.     property OnGetSiteInfo;
  157.     property OnStartDock;
  158.     property OnUnDock;
  159. {$ENDIF}
  160.   end;
  161.  
  162. implementation
  163.  
  164. uses Consts, VCLUtils;
  165.  
  166. const
  167.   Registered: Boolean = False;
  168.  
  169. type
  170.   PPointArray = ^TPointArray;
  171.   TPointArray = array [0..60 * 2 - 1] of TSmallPoint;
  172.  
  173. const
  174.   ClockData: array[0..60 * 4 - 1] of Byte = (
  175.     $00, $00, $C1, $E0, $44, $03, $EC, $E0, $7F, $06, $6F, $E1,
  176.     $A8, $09, $48, $E2, $B5, $0C, $74, $E3, $9F, $0F, $F0, $E4,
  177.     $5E, $12, $B8, $E6, $E9, $14, $C7, $E8, $39, $17, $17, $EB,
  178.     $48, $19, $A2, $ED, $10, $1B, $60, $F0, $8C, $1C, $4B, $F3,
  179.     $B8, $1D, $58, $F6, $91, $1E, $81, $F9, $14, $1F, $BC, $FC,
  180.     $40, $1F, $00, $00, $14, $1F, $44, $03, $91, $1E, $7F, $06,
  181.     $B8, $1D, $A8, $09, $8C, $1C, $B5, $0C, $10, $1B, $A0, $0F,
  182.     $48, $19, $5E, $12, $39, $17, $E9, $14, $E9, $14, $39, $17,
  183.     $5E, $12, $48, $19, $9F, $0F, $10, $1B, $B5, $0C, $8C, $1C,
  184.     $A8, $09, $B8, $1D, $7F, $06, $91, $1E, $44, $03, $14, $1F,
  185.     $00, $00, $3F, $1F, $BC, $FC, $14, $1F, $81, $F9, $91, $1E,
  186.     $58, $F6, $B8, $1D, $4B, $F3, $8C, $1C, $60, $F0, $10, $1B,
  187.     $A2, $ED, $48, $19, $17, $EB, $39, $17, $C7, $E8, $E9, $14,
  188.     $B8, $E6, $5E, $12, $F0, $E4, $9F, $0F, $74, $E3, $B5, $0C,
  189.     $48, $E2, $A8, $09, $6F, $E1, $7F, $06, $EC, $E0, $44, $03,
  190.     $C1, $E0, $00, $00, $EC, $E0, $BC, $FC, $6F, $E1, $81, $F9,
  191.     $48, $E2, $58, $F6, $74, $E3, $4B, $F3, $F0, $E4, $60, $F0,
  192.     $B8, $E6, $A2, $ED, $C7, $E8, $17, $EB, $17, $EB, $C7, $E8,
  193.     $A2, $ED, $B8, $E6, $61, $F0, $F0, $E4, $4B, $F3, $74, $E3,
  194.     $58, $F6, $48, $E2, $81, $F9, $6F, $E1, $BC, $FC, $EC, $E0);
  195.  
  196. const
  197.   AlarmSecDelay = 60; { seconds for try alarm event after alarm time occured }
  198.   MaxDotWidth   = 25; { maximum Hour-marking dot width  }
  199.   MinDotWidth   = 2;  { minimum Hour-marking dot width  }
  200.   MinDotHeight  = 1;  { minimum Hour-marking dot height }
  201.  
  202.   { distance from the center of the clock to... }
  203.   HourSide   = 7;   { ...either side of the Hour hand   }
  204.   MinuteSide = 5;   { ...either side of the Minute hand }
  205.   HourTip    = 60;  { ...the tip of the Hour hand       }
  206.   MinuteTip  = 80;  { ...the tip of the Minute hand     }
  207.   SecondTip  = 80;  { ...the tip of the Second hand     }
  208.   HourTail   = 15;  { ...the tail of the Hour hand      }
  209.   MinuteTail = 20;  { ...the tail of the Minute hand    }
  210.  
  211.   { conversion factors }
  212.   CirTabScale = 8000; { circle table values scale down value  }
  213.   MmPerDm     = 100;  { millimeters per decimeter             }
  214.  
  215.   { number of hand positions on... }
  216.   HandPositions = 60;                    { ...entire clock         }
  217.   SideShift     = (HandPositions div 4); { ...90 degrees of clock  }
  218.   TailShift     = (HandPositions div 2); { ...180 degrees of clock }
  219.  
  220. var
  221.   CircleTab: PPointArray;
  222.   HRes: Integer;    { width of the display (in pixels)                    }
  223.   VRes: Integer;    { height of the display (in raster lines)             }
  224.   AspectH: Longint; { number of pixels per decimeter on the display       }
  225.   AspectV: Longint; { number of raster lines per decimeter on the display }
  226.  
  227. { Exception routine }
  228.  
  229. procedure InvalidTime(Hour, Min, Sec: Word);
  230. var
  231.   sTime: string[50];
  232. begin
  233.   sTime := IntToStr(Hour) + TimeSeparator + IntToStr(Min) +
  234.     TimeSeparator + IntToStr(Sec);
  235.   raise EConvertError.CreateFmt(ResStr(SInvalidTime), [sTime]);
  236. end;
  237.  
  238. function VertEquiv(l: Integer): Integer;
  239. begin
  240.   VertEquiv := Longint(l) * AspectV div AspectH;
  241. end;
  242.  
  243. function HorzEquiv(l: Integer): Integer;
  244. begin
  245.   HorzEquiv := Longint(l) * AspectH div AspectV;
  246. end;
  247.  
  248. function LightColor(Color: TColor): TColor;
  249. var
  250.   L: Longint;
  251.   C: array[1..3] of Byte;
  252.   I: Byte;
  253. begin
  254.   L := ColorToRGB(Color);
  255.   C[1] := GetRValue(L); C[2] := GetGValue(L); C[3] := GetBValue(L);
  256.   for I := 1 to 3 do begin
  257.     if C[I] = $FF then begin
  258.       Result := clBtnHighlight;
  259.       Exit;
  260.     end;
  261.     if C[I] <> 0 then
  262.       if C[I] = $C0 then C[I] := $FF
  263.       else C[I] := C[I] + $7F;
  264.   end;
  265.   Result := TColor(RGB(C[1], C[2], C[3]));
  266. end;
  267.  
  268. procedure ClockInit;
  269. var
  270.   Pos: Integer;   { hand position Index into the circle table }
  271.   vSize: Integer; { height of the display in millimeters      }
  272.   hSize: Integer; { width of the display in millimeters       }
  273.   DC: HDC;
  274. begin
  275.   DC := GetDC(0);
  276.   try
  277.     VRes := GetDeviceCaps(DC, VERTRES);
  278.     HRes := GetDeviceCaps(DC, HORZRES);
  279.     vSize := GetDeviceCaps(DC, VERTSIZE);
  280.     hSize := GetDeviceCaps(DC, HORZSIZE);
  281.   finally
  282.     ReleaseDC(0, DC);
  283.   end;
  284.   AspectV := (Longint(VRes) * MmPerDm) div Longint(vSize);
  285.   AspectH := (Longint(HRes) * MmPerDm) div Longint(hSize);
  286.   CircleTab := PPointArray(@ClockData);
  287.   for Pos := 0 to HandPositions - 1 do
  288.     CircleTab^[Pos].Y := VertEquiv(CircleTab^[Pos].Y);
  289. end;
  290.  
  291. function HourHandPos(T: TRxClockTime): Integer;
  292. begin
  293.   Result := (T.Hour * 5) + (T.Minute div 12);
  294. end;
  295.  
  296. { Digital clock font routine }
  297.  
  298. procedure SetNewFontSize(Canvas: TCanvas; const Text: string;
  299.   MaxH, MaxW: Integer);
  300. const
  301.   fHeight = 1000;
  302. var
  303.   Font: TFont;
  304.   NewH: Integer;
  305. begin
  306.   Font := Canvas.Font;
  307.   { empiric calculate character height by cell height }
  308.   MaxH := MulDiv(MaxH, 4, 5);
  309.   with Font do begin
  310.     Height := -fHeight;
  311.     NewH := MulDiv(fHeight, MaxW, Canvas.TextWidth(Text));
  312.     if NewH > MaxH then NewH := MaxH;
  313.     Height := -NewH;
  314.   end;
  315. end;
  316.  
  317. { TRxClock }
  318.  
  319. constructor TRxClock.Create(AOwner: TComponent);
  320. begin
  321.   inherited Create(AOwner);
  322.   if not Registered then begin
  323.     ClockInit;
  324.     Registered := True;
  325.   end;
  326.   Caption := TimeToStr(Time);
  327.   ControlStyle := ControlStyle - [csSetCaption] 
  328.     {$IFDEF WIN32} - [csReplicatable] {$ENDIF};
  329.   BevelInner := bvLowered;
  330.   BevelOuter := bvRaised;
  331.   FTimer := TRxTimer.Create(Self);
  332.   FTimer.Interval := 450; { every second }
  333.   FTimer.OnTimer := TimerExpired;
  334.   FDotsColor := clTeal;
  335.   FShowSeconds := True;
  336.   FLeadingZero := True;
  337.   GetTime(FDisplayTime);
  338.   if FDisplayTime.Hour >= 12 then Dec(FDisplayTime.Hour, 12);
  339.   FAlarmWait := True;
  340.   FAlarm := EncodeTime(0, 0, 0, 0);
  341. end;
  342.  
  343. destructor TRxClock.Destroy;
  344. begin
  345.   if FHooked then begin
  346.     Application.UnhookMainWindow(FormatSettingsChange);
  347.     FHooked := False;
  348.   end;
  349.   inherited Destroy;
  350. end;
  351.  
  352. procedure TRxClock.Loaded;
  353. begin
  354.   inherited Loaded;
  355.   ResetAlarm;
  356. end;
  357.  
  358. procedure TRxClock.CreateWnd;
  359. begin
  360.   inherited CreateWnd;
  361.   if not (csDesigning in ComponentState) and not (IsLibrary or FHooked) then
  362.   begin
  363.     Application.HookMainWindow(FormatSettingsChange);
  364.     FHooked := True;
  365.   end;
  366. end;
  367.  
  368. procedure TRxClock.DestroyWindowHandle;
  369. begin
  370.   if FHooked then begin
  371.     Application.UnhookMainWindow(FormatSettingsChange);
  372.     FHooked := False;
  373.   end;
  374.   inherited DestroyWindowHandle;
  375. end;
  376.  
  377. procedure TRxClock.CMCtl3DChanged(var Message: TMessage);
  378. begin
  379.   inherited;
  380.   if ShowMode = scAnalog then Invalidate;
  381. end;
  382.  
  383. procedure TRxClock.CMTextChanged(var Message: TMessage);
  384. begin
  385.   { Skip this message, no repaint }
  386. end;
  387.  
  388. procedure TRxClock.CMFontChanged(var Message: TMessage);
  389. begin
  390.   inherited;
  391.   Invalidate;
  392.   if AutoSize then Realign;
  393. end;
  394.  
  395. procedure TRxClock.WMTimeChange(var Message: TMessage);
  396. begin
  397.   inherited;
  398.   Invalidate;
  399.   CheckAlarm;
  400. end;
  401.  
  402. function TRxClock.FormatSettingsChange(var Message: TMessage): Boolean;
  403. begin
  404.   Result := False;
  405.   case Message.Msg of
  406.     WM_WININICHANGE:
  407.       begin
  408.         Invalidate;
  409.         if AutoSize then Realign;
  410.       end;
  411.   end;
  412. end;
  413.  
  414. function TRxClock.GetSystemTime: TDateTime;
  415. begin
  416.   Result := SysUtils.Time;
  417.   if Assigned(FOnGetTime) then FOnGetTime(Self, Result);
  418. end;
  419.  
  420. procedure TRxClock.GetTime(var T: TRxClockTime);
  421. var
  422.   MSec: Word;
  423. begin
  424.   with T do
  425.     DecodeTime(GetSystemTime, Hour, Minute, Second, MSec);
  426. end;
  427.  
  428. procedure TRxClock.UpdateClock;
  429. begin
  430.   Invalidate;
  431.   if AutoSize then Realign;
  432.   Update;
  433. end;
  434.  
  435. procedure TRxClock.ResetAlarm;
  436. begin
  437.   FAlarmWait := (FAlarm > GetSystemTime) or (FAlarm = 0);
  438. end;
  439.  
  440. function TRxClock.IsAlarmTime(ATime: TDateTime): Boolean;
  441. var
  442.   Hour, Min, Sec, MSec: Word;
  443.   AHour, AMin, ASec: Word;
  444. begin
  445.   DecodeTime(FAlarm, Hour, Min, Sec, MSec);
  446.   DecodeTime(ATime, AHour, AMin, ASec, MSec);
  447.   Result := {FAlarmWait and} (Hour = AHour) and (Min = AMin) and
  448.     (ASec >= Sec) and (ASec <= Sec + AlarmSecDelay);
  449. end;
  450.  
  451. procedure TRxClock.ResizeFont(const Rect: TRect);
  452. var
  453.   H, W: Integer;
  454.   DC: HDC;
  455.   TimeStr: string;
  456. begin
  457.   H := Rect.Bottom - Rect.Top - 4;
  458.   W := (Rect.Right - Rect.Left - 30);
  459.   if (H <= 0) or (W <= 0) then Exit;
  460.   DC := GetDC(0);
  461.   try
  462.     Canvas.Handle := DC;
  463.     Canvas.Font := Font;
  464.     TimeStr := '88888';
  465.     if FShowSeconds then TimeStr := TimeStr + '888';
  466.     if FTwelveHour then begin
  467.       if Canvas.TextWidth(TimeAMString) > Canvas.TextWidth(TimePMString) then
  468.         TimeStr := TimeStr + ' ' + TimeAMString
  469.       else TimeStr := TimeStr + ' ' + TimePMString;
  470.     end;
  471.     SetNewFontSize(Canvas, TimeStr, H, W);
  472.     Font := Canvas.Font;
  473.   finally
  474.     Canvas.Handle := 0;
  475.     ReleaseDC(0, DC);
  476.   end;
  477. end;
  478.  
  479. procedure TRxClock.AlignControls(AControl: TControl; var Rect: TRect);
  480. {$IFDEF RX_D4}
  481. var
  482.   InflateWidth: Integer;
  483. {$ENDIF}
  484. begin
  485.   inherited AlignControls(AControl, Rect);
  486.   FClockRect := Rect;
  487. {$IFDEF RX_D4}
  488.   InflateWidth := BorderWidth + 1;
  489.   if BevelOuter <> bvNone then Inc(InflateWidth, BevelWidth);
  490.   if BevelInner <> bvNone then Inc(InflateWidth, BevelWidth);
  491.   InflateRect(FClockRect, -InflateWidth, -InflateWidth);
  492. {$ENDIF}
  493.   with FClockRect do CircleClock(Right - Left, Bottom - Top);
  494.   if AutoSize then ResizeFont(Rect);
  495. end;
  496.  
  497. procedure TRxClock.Alarm;
  498. begin
  499.   if Assigned(FOnAlarm) then FOnAlarm(Self);
  500. end;
  501.  
  502. procedure TRxClock.SetAutoSize(Value: Boolean);
  503. begin
  504.   if (Value <> FAutoSize) then begin
  505.     FAutoSize := Value;
  506.     if FAutoSize then begin
  507.       Invalidate;
  508.       Realign;
  509.     end;
  510.   end;
  511. end;
  512.  
  513. procedure TRxClock.SetTwelveHour(Value: Boolean);
  514. begin
  515.   if FTwelveHour <> Value then begin
  516.     FTwelveHour := Value;
  517.     Invalidate;
  518.     if AutoSize then Realign;
  519.   end;
  520. end;
  521.  
  522. procedure TRxClock.SetLeadingZero(Value: Boolean);
  523. begin
  524.   if FLeadingZero <> Value then begin
  525.     FLeadingZero := Value;
  526.     Invalidate;
  527.   end;
  528. end;
  529.  
  530. procedure TRxClock.SetShowSeconds(Value: Boolean);
  531. begin
  532.   if FShowSeconds <> Value then begin
  533.     {if FShowSeconds and (ShowMode = scAnalog) then
  534.       DrawSecondHand(FDisplayTime.Second);}
  535.     FShowSeconds := Value;
  536.     Invalidate;
  537.     if AutoSize then Realign;
  538.   end;
  539. end;
  540.  
  541. procedure TRxClock.SetDotsColor(Value: TColor);
  542. begin
  543.   if Value <> FDotsColor then begin
  544.     FDotsColor := Value;
  545.     Invalidate;
  546.   end;
  547. end;
  548.  
  549. procedure TRxClock.SetShowMode(Value: TShowClock);
  550. begin
  551.   if FShowMode <> Value then begin
  552.     FShowMode := Value;
  553.     Invalidate;
  554.   end;
  555. end;
  556.  
  557. function TRxClock.GetAlarmElement(Index: Integer): Byte;
  558. var
  559.   Hour, Min, Sec, MSec: Word;
  560. begin
  561.   DecodeTime(FAlarm, Hour, Min, Sec, MSec);
  562.   case Index of
  563.     1: Result := Hour;
  564.     2: Result := Min;
  565.     3: Result := Sec;
  566.     else Result := 0;
  567.   end;
  568. end;
  569.  
  570. procedure TRxClock.SetAlarmElement(Index: Integer; Value: Byte);
  571. var
  572.   Hour, Min, Sec, MSec: Word;
  573. begin
  574.   DecodeTime(FAlarm, Hour, Min, Sec, MSec);
  575.   case Index of
  576.     1: Hour := Value;
  577.     2: Min := Value;
  578.     3: Sec := Value;
  579.     else Exit;
  580.   end;
  581.   if (Hour < 24) and (Min < 60) and (Sec < 60) then begin
  582.     FAlarm := EncodeTime(Hour, Min, Sec, 0);
  583.     ResetAlarm;
  584.   end
  585.   else InvalidTime(Hour, Min, Sec);
  586. end;
  587.  
  588. procedure TRxClock.SetAlarmTime(AlarmTime: TDateTime);
  589. var
  590.   Hour, Min, Sec, MSec: Word;
  591. begin
  592.   DecodeTime(FAlarm, Hour, Min, Sec, MSec);
  593.   if (Hour < 24) and (Min < 60) and (Sec < 60) then begin
  594.     FAlarm := Frac(AlarmTime);
  595.     ResetAlarm;
  596.   end
  597.   else InvalidTime(Hour, Min, Sec);
  598. end;
  599.  
  600. procedure TRxClock.TimerExpired(Sender: TObject);
  601. var
  602.   DC: HDC;
  603.   Rect: TRect;
  604.   InflateWidth: Integer;
  605. begin
  606.   DC := GetDC(Handle);
  607.   try
  608.     Canvas.Handle := DC;
  609.     Canvas.Brush.Color := Color;
  610.     Canvas.Font := Font;
  611.     Canvas.Pen.Color := Font.Color;
  612.     if FShowMode = scAnalog then PaintAnalogClock(pmHandPaint)
  613.     else begin
  614.       Rect := GetClientRect;
  615.       InflateWidth := BorderWidth;
  616.       if BevelOuter <> bvNone then Inc(InflateWidth, BevelWidth);
  617.       if BevelInner <> bvNone then Inc(InflateWidth, BevelWidth);
  618.       InflateRect(Rect, -InflateWidth, -InflateWidth);
  619.       PaintTimeStr(Rect, False);
  620.     end;
  621.   finally
  622.     Canvas.Handle := 0;
  623.     ReleaseDC(Handle, DC);
  624.   end;
  625.   CheckAlarm;
  626. end;
  627.  
  628. procedure TRxClock.CheckAlarm;
  629. begin
  630.   if FAlarmEnabled and IsAlarmTime(GetSystemTime) then begin
  631.     if FAlarmWait then begin
  632.       FAlarmWait := False;
  633.       Alarm;
  634.     end;
  635.   end
  636.   else ResetAlarm;
  637. end;
  638.  
  639. procedure TRxClock.DrawAnalogFace;
  640. var
  641.   Pos, DotHeight, DotWidth: Integer;
  642.   DotCenter: TPoint;
  643.   R: TRect;
  644.   SaveBrush, SavePen: TColor;
  645.   MinDots: Boolean;
  646. begin
  647.   DotWidth := (MaxDotWidth * Longint(FClockRect.Right - FClockRect.Left)) div HRes;
  648.   DotHeight := VertEquiv(DotWidth);
  649.   if DotHeight < MinDotHeight then DotHeight := MinDotHeight;
  650.   if DotWidth < MinDotWidth then DotWidth := MinDotWidth;
  651.   DotCenter.X := DotWidth div 2;
  652.   DotCenter.Y := DotHeight div 2;
  653.   InflateRect(FClockRect, -DotCenter.Y, -DotCenter.X);
  654.   FClockRadius := ((FClockRect.Right - FClockRect.Left) div 2);
  655.   FClockCenter.X := FClockRect.Left + FClockRadius;
  656.   FClockCenter.Y := FClockRect.Top + ((FClockRect.Bottom - FClockRect.Top) div 2);
  657.   InflateRect(FClockRect, DotCenter.Y, DotCenter.X);
  658.   SaveBrush := Canvas.Brush.Color;
  659.   SavePen := Canvas.Pen.Color;
  660.   try
  661.     Canvas.Brush.Color := Canvas.Pen.Color;
  662.     MinDots := ((DotWidth > MinDotWidth) and (DotHeight > MinDotHeight));
  663.     for Pos := 0 to HandPositions - 1 do begin
  664.       R.Top := (CircleTab^[Pos].Y * FClockRadius) div CirTabScale + FClockCenter.Y;
  665.       R.Left := (CircleTab^[Pos].X * FClockRadius) div CirTabScale + FClockCenter.X;
  666.       if (Pos mod 5) <> 0 then begin
  667.         if MinDots then begin
  668.           if Ctl3D then begin
  669.             Canvas.Brush.Color := clBtnShadow;
  670.             OffsetRect(R, -1, -1);
  671.             R.Right := R.Left + 2;
  672.             R.Bottom := R.Top + 2;
  673.             Canvas.FillRect(R);
  674.             Canvas.Brush.Color := clBtnHighlight;
  675.             OffsetRect(R, 1, 1);
  676.             Canvas.FillRect(R);
  677.             Canvas.Brush.Color := Self.Color;
  678.           end;
  679.           R.Right := R.Left + 1;
  680.           R.Bottom := R.Top + 1;
  681.           Canvas.FillRect(R);
  682.         end;
  683.       end
  684.       else begin
  685.         R.Right := R.Left + DotWidth;
  686.         R.Bottom := R.Top + DotHeight;
  687.         OffsetRect(R, -DotCenter.X, -DotCenter.Y);
  688.         if Ctl3D and MinDots then
  689.           with Canvas do begin
  690.             Brush.Color := FDotsColor;
  691.             Brush.Style := bsSolid;
  692.             FillRect(R);
  693.             Frame3D(Canvas, R, LightColor(FDotsColor), clWindowFrame, 1);
  694.           end;
  695.         Canvas.Brush.Color := Canvas.Pen.Color;
  696.         if not (Ctl3D and MinDots) then Canvas.FillRect(R);
  697.       end;
  698.     end;
  699.   finally
  700.     Canvas.Brush.Color := SaveBrush;
  701.     Canvas.Pen.Color := SavePen;
  702.   end;
  703. end;
  704.  
  705. procedure TRxClock.CircleClock(MaxWidth, MaxHeight: Integer);
  706. var
  707.   ClockHeight: Integer;
  708.   ClockWidth: Integer;
  709. begin
  710.   if MaxWidth > HorzEquiv(MaxHeight) then begin
  711.     ClockWidth := HorzEquiv(MaxHeight);
  712.     FClockRect.Left := FClockRect.Left + ((MaxWidth - ClockWidth) div 2);
  713.     FClockRect.Right := FClockRect.Left + ClockWidth;
  714.   end
  715.   else begin
  716.     ClockHeight := VertEquiv(MaxWidth);
  717.     FClockRect.Top := FClockRect.Top + ((MaxHeight - ClockHeight) div 2);
  718.     FClockRect.Bottom := FClockRect.Top + ClockHeight;
  719.   end;
  720. end;
  721.  
  722. procedure TRxClock.DrawSecondHand(Pos: Integer);
  723. var
  724.   Radius: Longint;
  725.   SaveMode: TPenMode;
  726. begin
  727.   Radius := (FClockRadius * SecondTip) div 100;
  728.   SaveMode := Canvas.Pen.Mode;
  729.   Canvas.Pen.Mode := pmNot;
  730.   try
  731.     Canvas.MoveTo(FClockCenter.X, FClockCenter.Y);
  732.     Canvas.LineTo(FClockCenter.X + ((CircleTab^[Pos].X * Radius) div
  733.       CirTabScale), FClockCenter.Y + ((CircleTab^[Pos].Y * Radius) div
  734.       CirTabScale));
  735.   finally
  736.     Canvas.Pen.Mode := SaveMode;
  737.   end;
  738. end;
  739.  
  740. procedure TRxClock.DrawFatHand(Pos: Integer; HourHand: Boolean);
  741. var
  742.   ptSide, ptTail, ptTip: TPoint;
  743.   Index, Hand: Integer;
  744.   Scale: Longint;
  745.   SaveMode: TPenMode;
  746. begin
  747.   if HourHand then Hand := HourSide else Hand := MinuteSide;
  748.   Scale := (FClockRadius * Hand) div 100;
  749.   Index := (Pos + SideShift) mod HandPositions;
  750.   ptSide.Y := (CircleTab^[Index].Y * Scale) div CirTabScale;
  751.   ptSide.X := (CircleTab^[Index].X * Scale) div CirTabScale;
  752.   if HourHand then Hand := HourTip else Hand := MinuteTip;
  753.   Scale := (FClockRadius * Hand) div 100;
  754.   ptTip.Y := (CircleTab^[Pos].Y * Scale) div CirTabScale;
  755.   ptTip.X := (CircleTab^[Pos].X * Scale) div CirTabScale;
  756.   if HourHand then Hand := HourTail else Hand := MinuteTail;
  757.   Scale := (FClockRadius * Hand) div 100;
  758.   Index := (Pos + TailShift) mod HandPositions;
  759.   ptTail.Y := (CircleTab^[Index].Y * Scale) div CirTabScale;
  760.   ptTail.X := (CircleTab^[Index].X * Scale) div CirTabScale;
  761.   with Canvas do begin
  762.     SaveMode := Pen.Mode;
  763.     Pen.Mode := pmCopy;
  764.     try
  765.       MoveTo(FClockCenter.X + ptSide.X, FClockCenter.Y + ptSide.Y);
  766.       LineTo(FClockCenter.X + ptTip.X, FClockCenter.Y + ptTip.Y);
  767.       MoveTo(FClockCenter.X - ptSide.X, FClockCenter.Y - ptSide.Y);
  768.       LineTo(FClockCenter.X + ptTip.X, FClockCenter.Y + ptTip.Y);
  769.       MoveTo(FClockCenter.X + ptSide.X, FClockCenter.Y + ptSide.Y);
  770.       LineTo(FClockCenter.X + ptTail.X, FClockCenter.Y + ptTail.Y);
  771.       MoveTo(FClockCenter.X - ptSide.X, FClockCenter.Y - ptSide.Y);
  772.       LineTo(FClockCenter.X + ptTail.X, FClockCenter.Y + ptTail.Y);
  773.     finally
  774.       Pen.Mode := SaveMode;
  775.     end;
  776.   end;
  777. end;
  778.  
  779. procedure TRxClock.PaintAnalogClock(PaintMode: TPaintMode);
  780. var
  781.   NewTime: TRxClockTime;
  782. begin
  783.   Canvas.Pen.Color := Font.Color;
  784.   Canvas.Brush.Color := Color;
  785.   SetBkMode(Canvas.Handle, TRANSPARENT);
  786.   if PaintMode = pmPaintAll then begin
  787.     with Canvas do begin
  788.       FillRect(FClockRect);
  789.       Pen.Color := Self.Font.Color;
  790.       DrawAnalogFace;
  791.       DrawFatHand(HourHandPos(FDisplayTime), True);
  792.       DrawFatHand(FDisplayTime.Minute, False);
  793.       Pen.Color := Brush.Color;
  794.       if ShowSeconds then DrawSecondHand(FDisplayTime.Second);
  795.     end;
  796.   end
  797.   else begin
  798.     with Canvas do begin
  799.       Pen.Color := Brush.Color;
  800.       GetTime(NewTime);
  801.       if NewTime.Hour >= 12 then Dec(NewTime.Hour, 12);
  802.       if (NewTime.Second <> FDisplayTime.Second) then
  803.         if ShowSeconds then DrawSecondHand(FDisplayTime.Second);
  804.       if ((NewTime.Minute <> FDisplayTime.Minute) or
  805.         (NewTime.Hour <> FDisplayTime.Hour)) then
  806.       begin
  807.         DrawFatHand(FDisplayTime.Minute, False);
  808.         DrawFatHand(HourHandPos(FDisplayTime), True);
  809.         Pen.Color := Self.Font.Color;
  810.         DrawFatHand(NewTime.Minute, False);
  811.         DrawFatHand(HourHandPos(NewTime), True);
  812.       end;
  813.       Pen.Color := Brush.Color;
  814.       if (NewTime.Second <> FDisplayTime.Second) then begin
  815.         if ShowSeconds then DrawSecondHand(NewTime.Second);
  816.         FDisplayTime := NewTime;
  817.       end;
  818.     end;
  819.   end;
  820. end;
  821.  
  822. procedure TRxClock.PaintTimeStr(var Rect: TRect; FullTime: Boolean);
  823. var
  824.   FontHeight, FontWidth, FullWidth, I, L, H: Integer;
  825.   TimeStr, SAmPm: string;
  826.   NewTime: TRxClockTime;
  827.  
  828.   function IsPartSym(Idx, Num: Byte): Boolean;
  829.   var
  830.     TwoSymHour: Boolean;
  831.   begin
  832.     TwoSymHour := (H >= 10) or FLeadingZero;
  833.     case Idx of
  834.       1: begin {hours}
  835.            Result := True;
  836.          end;
  837.       2: begin {minutes}
  838.            if TwoSymHour then Result := (Num in [4, 5])
  839.            else Result := (Num in [3, 4]);
  840.          end;
  841.       3: begin {seconds}
  842.            if TwoSymHour then Result := FShowSeconds and (Num in [7, 8])
  843.            else Result := FShowSeconds and (Num in [6, 7]);
  844.          end;
  845.       else Result := False;
  846.     end;
  847.   end;
  848.  
  849.   procedure DrawSym(Sym: Char; Num: Byte);
  850.   begin
  851.     if FullTime or
  852.       ((NewTime.Second <> FDisplayTime.Second) and IsPartSym(3, Num)) or
  853.       ((NewTime.Minute <> FDisplayTime.Minute) and IsPartSym(2, Num)) or
  854.       (NewTime.Hour <> FDisplayTime.Hour) then
  855.     begin
  856.       Canvas.FillRect(Rect);
  857.       DrawText(Canvas.Handle, @Sym, 1, Rect, DT_EXPANDTABS or
  858.         DT_VCENTER or DT_CENTER or DT_NOCLIP or DT_SINGLELINE);
  859.     end;
  860.   end;
  861.  
  862. begin
  863.   GetTime(NewTime);
  864.   H := NewTime.Hour;
  865.   if NewTime.Hour >= 12 then Dec(NewTime.Hour, 12);
  866.   if FTwelveHour then begin
  867.     if H > 12 then Dec(H, 12) else if H = 0 then H := 12;
  868.   end;
  869.   if (not FullTime) and (NewTime.Hour <> FDisplayTime.Hour) then begin
  870.     Repaint;
  871.     Exit;
  872.   end;
  873.   if FLeadingZero then TimeStr := 'hh:mm' else TimeStr := 'h:mm';
  874.   if FShowSeconds then TimeStr := TimeStr + ':ss';
  875.   if FTwelveHour then TimeStr := TimeStr + ' ampm';
  876.   with NewTime do
  877.     TimeStr := FormatDateTime(TimeStr, GetSystemTime);
  878.   if (H >= 10) or FLeadingZero then L := 5 else L := 4;
  879.   if FShowSeconds then Inc(L, 3);
  880.   SAmPm := Copy(TimeStr, L + 1, MaxInt);
  881.   with Canvas do begin
  882.     Font := Self.Font;
  883.     FontHeight := TextHeight('8');
  884.     FontWidth := TextWidth('8');
  885.     FullWidth := TextWidth(SAmPm) + (L * FontWidth);
  886.     with Rect do begin
  887.       Left := ((Right + Left) - FullWidth) div 2 {shr 1};
  888.       Right := Left + FullWidth;
  889.       Top := ((Bottom + Top) - FontHeight) div 2 {shr 1};
  890.       Bottom := Top + FontHeight;
  891.     end;
  892.     Brush.Color := Color;
  893.     for I := 1 to L do begin
  894.       Rect.Right := Rect.Left + FontWidth;
  895.       DrawSym(TimeStr[I], I);
  896.       Inc(Rect.Left, FontWidth);
  897.     end;
  898.     if FullTime or (NewTime.Hour <> FDisplayTime.Hour) then begin
  899.       Rect.Right := Rect.Left + TextWidth(SAmPm);
  900.       DrawText(Handle, @SAmPm[1], Length(SAmPm), Rect,
  901.         DT_EXPANDTABS or DT_VCENTER or DT_NOCLIP or DT_SINGLELINE);
  902.     end;
  903.   end;
  904.   FDisplayTime := NewTime;
  905. end;
  906.  
  907. procedure TRxClock.Paint3DFrame(var Rect: TRect);
  908. var
  909.   TopColor, BottomColor: TColor;
  910.  
  911.   procedure AdjustColors(Bevel: TPanelBevel);
  912.   begin
  913.     TopColor := clBtnHighlight;
  914.     if Bevel = bvLowered then TopColor := clBtnShadow;
  915.     BottomColor := clBtnShadow;
  916.     if Bevel = bvLowered then BottomColor := clBtnHighlight;
  917.   end;
  918.  
  919. begin
  920.   Rect := GetClientRect;
  921.   with Canvas do begin
  922.     Brush.Color := Color;
  923.     FillRect(Rect);
  924.   end;
  925.   if BevelOuter <> bvNone then begin
  926.     AdjustColors(BevelOuter);
  927.     Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
  928.   end;
  929.   InflateRect(Rect, -BorderWidth, -BorderWidth);
  930.   if BevelInner <> bvNone then begin
  931.     AdjustColors(BevelInner);
  932.     Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
  933.   end;
  934. end;
  935.  
  936. procedure TRxClock.Paint;
  937. var
  938.   R: TRect;
  939. begin
  940.   Paint3DFrame(R);
  941.   case FShowMode of
  942.     scDigital: PaintTimeStr(R, True);
  943.     scAnalog: PaintAnalogClock(pmPaintAll);
  944.   end;
  945. end;
  946.  
  947. end.