You've already forked lazarus-ccr
RxFPC - current version in folder trunk
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2813 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
alexs75
990
components/rx/trunk/rxclock.pas
Normal file
990
components/rx/trunk/rxclock.pas
Normal file
@ -0,0 +1,990 @@
|
||||
{ rxclock unit
|
||||
|
||||
Copyright (C) 2005-2010 Lagunov Aleksey alexs@hotbox.ru and Lazarus team
|
||||
original conception from rx library for Delphi (c)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the terms of the GNU Library General Public License as published by
|
||||
the Free Software Foundation; either version 2 of the License, or (at your
|
||||
option) any later version with the following modification:
|
||||
|
||||
As a special exception, the copyright holders of this library give you
|
||||
permission to link this library with independent modules to produce an
|
||||
executable, regardless of the license terms of these independent modules,and
|
||||
to copy and distribute the resulting executable under terms of your choice,
|
||||
provided that you also meet, for each linked independent module, the terms
|
||||
and conditions of the license of that module. An independent module is a
|
||||
module which is not derived from or based on this library. If you modify
|
||||
this library, you may extend this exception to your version of the library,
|
||||
but you are not obligated to do so. If you do not wish to do so, delete this
|
||||
exception statement from your version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but WITHOUT
|
||||
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
||||
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
|
||||
for more details.
|
||||
|
||||
You should have received a copy of the GNU Library General Public License
|
||||
along with this library; if not, write to the Free Software Foundation,
|
||||
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
}
|
||||
|
||||
unit rxclock;
|
||||
|
||||
interface
|
||||
|
||||
{$I rx.inc}
|
||||
uses LCLType, LMessages, SysUtils, Classes, Graphics, Controls, Forms, {StdCtrls,}
|
||||
ExtCtrls, Menus, messages;
|
||||
|
||||
type
|
||||
TShowClock = (scDigital, scAnalog);
|
||||
TPaintMode = (pmPaintAll, pmHandPaint);
|
||||
|
||||
TRxClockTime = packed record
|
||||
Hour, Minute, Second: Word;
|
||||
end;
|
||||
|
||||
TRxGetTimeEvent = procedure (Sender: TObject; var ATime: TDateTime) of object;
|
||||
|
||||
{ TRxClock }
|
||||
|
||||
TRxClock = class(TCustomPanel)
|
||||
private
|
||||
{ Private declarations }
|
||||
FTimer: TTimer;
|
||||
FAutoSize: Boolean;
|
||||
FShowMode: TShowClock;
|
||||
FTwelveHour: Boolean;
|
||||
FLeadingZero: Boolean;
|
||||
FShowSeconds: Boolean;
|
||||
FAlarm: TDateTime;
|
||||
FAlarmEnabled: Boolean;
|
||||
FHooked: Boolean;
|
||||
FDotsColor: TColor;
|
||||
FAlarmWait: Boolean;
|
||||
FDisplayTime: TRxClockTime;
|
||||
FClockRect: TRect;
|
||||
FClockRadius: Longint;
|
||||
FClockCenter: TPoint;
|
||||
FOnGetTime: TRxGetTimeEvent;
|
||||
FOnAlarm: TNotifyEvent;
|
||||
procedure TimerExpired(Sender: TObject);
|
||||
procedure GetTime(var T: TRxClockTime);
|
||||
function IsAlarmTime(ATime: TDateTime): Boolean;
|
||||
procedure SetShowMode(Value: TShowClock);
|
||||
function GetAlarmElement(Index: Integer): Byte;
|
||||
procedure SetAlarmElement(Index: Integer; Value: Byte);
|
||||
procedure SetDotsColor(Value: TColor);
|
||||
procedure SetTwelveHour(Value: Boolean);
|
||||
procedure SetLeadingZero(Value: Boolean);
|
||||
procedure SetShowSeconds(Value: Boolean);
|
||||
procedure PaintAnalogClock(PaintMode: TPaintMode);
|
||||
procedure Paint3DFrame(var Rect: TRect);
|
||||
procedure DrawAnalogFace;
|
||||
procedure CircleClock(MaxWidth, MaxHeight: Integer);
|
||||
procedure DrawSecondHand(Pos: Integer);
|
||||
procedure DrawFatHand(Pos: Integer; HourHand: Boolean);
|
||||
procedure PaintTimeStr(var Rect: TRect; FullTime: Boolean);
|
||||
procedure ResizeFont(const Rect: TRect);
|
||||
procedure ResetAlarm;
|
||||
procedure CheckAlarm;
|
||||
function FormatSettingsChange(var Message: TLMessage): Boolean;
|
||||
// procedure CMCtl3DChanged(var Message: TLMessage); message CM_CTL3DCHANGED;
|
||||
procedure CMTextChanged(var Message: TLMessage); message CM_TEXTCHANGED;
|
||||
procedure CMFontChanged(var Message: TLMessage); message CM_FONTCHANGED;
|
||||
{$IFDEF windows}
|
||||
procedure WMTimeChange(var Message: TLMessage); message WM_TIMECHANGE;
|
||||
{$ENDIF}
|
||||
protected
|
||||
{ Protected declarations }
|
||||
procedure SetAutoSize(const Value: Boolean); virtual;
|
||||
procedure Alarm; dynamic;
|
||||
procedure AlignControls(AControl: TControl; var Rect: TRect); override;
|
||||
procedure CreateWnd; override;
|
||||
// procedure DestroyWindowHandle; override;
|
||||
procedure Loaded; override;
|
||||
procedure Paint; override;
|
||||
function GetSystemTime: TDateTime; virtual;
|
||||
public
|
||||
{ Public declarations }
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
procedure SetAlarmTime(AlarmTime: TDateTime);
|
||||
procedure UpdateClock;
|
||||
published
|
||||
{ Published declarations }
|
||||
property AlarmEnabled: Boolean read FAlarmEnabled write FAlarmEnabled default False;
|
||||
property AlarmHour: Byte Index 1 read GetAlarmElement write SetAlarmElement default 0;
|
||||
property AlarmMinute: Byte Index 2 read GetAlarmElement write SetAlarmElement default 0;
|
||||
property AlarmSecond: Byte Index 3 read GetAlarmElement write SetAlarmElement default 0;
|
||||
property AutoSize: Boolean read FAutoSize write SetAutoSize default False;
|
||||
property BevelInner default bvLowered;
|
||||
property BevelOuter default bvRaised;
|
||||
property DotsColor: TColor read FDotsColor write SetDotsColor default clTeal;
|
||||
property ShowMode: TShowClock read FShowMode write SetShowMode default scDigital;
|
||||
property ShowSeconds: Boolean read FShowSeconds write SetShowSeconds default True;
|
||||
property TwelveHour: Boolean read FTwelveHour write SetTwelveHour default False;
|
||||
property LeadingZero: Boolean read FLeadingZero write SetLeadingZero default True;
|
||||
property Align;
|
||||
property BevelWidth;
|
||||
property BorderWidth;
|
||||
property BorderStyle;
|
||||
{$IFDEF RX_D4}
|
||||
property Anchors;
|
||||
property Constraints;
|
||||
property UseDockManager default True;
|
||||
property DockSite;
|
||||
property DragKind;
|
||||
property FullRepaint;
|
||||
{$ENDIF}
|
||||
property Color;
|
||||
property Cursor;
|
||||
property DragMode;
|
||||
property DragCursor;
|
||||
property Enabled;
|
||||
property Font;
|
||||
property ParentColor;
|
||||
property ParentFont;
|
||||
property ParentShowHint;
|
||||
property PopupMenu;
|
||||
property ShowHint;
|
||||
property Visible;
|
||||
property OnAlarm: TNotifyEvent read FOnAlarm write FOnAlarm;
|
||||
property OnGetTime: TRxGetTimeEvent read FOnGetTime write FOnGetTime;
|
||||
property OnClick;
|
||||
property OnDblClick;
|
||||
property OnMouseMove;
|
||||
property OnMouseDown;
|
||||
property OnMouseUp;
|
||||
property OnDragOver;
|
||||
property OnDragDrop;
|
||||
property OnEndDrag;
|
||||
property OnResize;
|
||||
property OnContextPopup;
|
||||
property OnStartDrag;
|
||||
// property OnCanResize;
|
||||
property OnConstrainedResize;
|
||||
property OnDockDrop;
|
||||
property OnDockOver;
|
||||
property OnEndDock;
|
||||
// property OnGetSiteInfo;
|
||||
// property OnStartDock;
|
||||
// property OnUnDock;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses VCLUtils, RTLConsts{, LConsts}, LCLIntf;
|
||||
|
||||
const
|
||||
Registered: Boolean = False;
|
||||
|
||||
type
|
||||
PPointArray = ^TPointArray;
|
||||
TPointArray = array [0..60 * 2 - 1] of TSmallPoint;
|
||||
|
||||
const
|
||||
ClockData: array[0..60 * 4 - 1] of Byte = (
|
||||
$00, $00, $C1, $E0, $44, $03, $EC, $E0, $7F, $06, $6F, $E1,
|
||||
$A8, $09, $48, $E2, $B5, $0C, $74, $E3, $9F, $0F, $F0, $E4,
|
||||
$5E, $12, $B8, $E6, $E9, $14, $C7, $E8, $39, $17, $17, $EB,
|
||||
$48, $19, $A2, $ED, $10, $1B, $60, $F0, $8C, $1C, $4B, $F3,
|
||||
$B8, $1D, $58, $F6, $91, $1E, $81, $F9, $14, $1F, $BC, $FC,
|
||||
$40, $1F, $00, $00, $14, $1F, $44, $03, $91, $1E, $7F, $06,
|
||||
$B8, $1D, $A8, $09, $8C, $1C, $B5, $0C, $10, $1B, $A0, $0F,
|
||||
$48, $19, $5E, $12, $39, $17, $E9, $14, $E9, $14, $39, $17,
|
||||
$5E, $12, $48, $19, $9F, $0F, $10, $1B, $B5, $0C, $8C, $1C,
|
||||
$A8, $09, $B8, $1D, $7F, $06, $91, $1E, $44, $03, $14, $1F,
|
||||
$00, $00, $3F, $1F, $BC, $FC, $14, $1F, $81, $F9, $91, $1E,
|
||||
$58, $F6, $B8, $1D, $4B, $F3, $8C, $1C, $60, $F0, $10, $1B,
|
||||
$A2, $ED, $48, $19, $17, $EB, $39, $17, $C7, $E8, $E9, $14,
|
||||
$B8, $E6, $5E, $12, $F0, $E4, $9F, $0F, $74, $E3, $B5, $0C,
|
||||
$48, $E2, $A8, $09, $6F, $E1, $7F, $06, $EC, $E0, $44, $03,
|
||||
$C1, $E0, $00, $00, $EC, $E0, $BC, $FC, $6F, $E1, $81, $F9,
|
||||
$48, $E2, $58, $F6, $74, $E3, $4B, $F3, $F0, $E4, $60, $F0,
|
||||
$B8, $E6, $A2, $ED, $C7, $E8, $17, $EB, $17, $EB, $C7, $E8,
|
||||
$A2, $ED, $B8, $E6, $61, $F0, $F0, $E4, $4B, $F3, $74, $E3,
|
||||
$58, $F6, $48, $E2, $81, $F9, $6F, $E1, $BC, $FC, $EC, $E0);
|
||||
|
||||
const
|
||||
AlarmSecDelay = 60; { seconds for try alarm event after alarm time occured }
|
||||
MaxDotWidth = 25; { maximum Hour-marking dot width }
|
||||
MinDotWidth = 2; { minimum Hour-marking dot width }
|
||||
MinDotHeight = 1; { minimum Hour-marking dot height }
|
||||
|
||||
{ distance from the center of the clock to... }
|
||||
HourSide = 7; { ...either side of the Hour hand }
|
||||
MinuteSide = 5; { ...either side of the Minute hand }
|
||||
HourTip = 60; { ...the tip of the Hour hand }
|
||||
MinuteTip = 80; { ...the tip of the Minute hand }
|
||||
SecondTip = 80; { ...the tip of the Second hand }
|
||||
HourTail = 15; { ...the tail of the Hour hand }
|
||||
MinuteTail = 20; { ...the tail of the Minute hand }
|
||||
|
||||
{ conversion factors }
|
||||
CirTabScale = 8000; { circle table values scale down value }
|
||||
MmPerDm = 100; { millimeters per decimeter }
|
||||
|
||||
{ number of hand positions on... }
|
||||
HandPositions = 60; { ...entire clock }
|
||||
SideShift = (HandPositions div 4); { ...90 degrees of clock }
|
||||
TailShift = (HandPositions div 2); { ...180 degrees of clock }
|
||||
|
||||
var
|
||||
CircleTab: PPointArray;
|
||||
HRes: Integer; { width of the display (in pixels) }
|
||||
VRes: Integer; { height of the display (in raster lines) }
|
||||
AspectH: Longint; { number of pixels per decimeter on the display }
|
||||
AspectV: Longint; { number of raster lines per decimeter on the display }
|
||||
|
||||
{ Exception routine }
|
||||
|
||||
procedure InvalidTime(Hour, Min, Sec: Word);
|
||||
var
|
||||
sTime: string[50];
|
||||
begin
|
||||
sTime := IntToStr(Hour) + DefaultFormatSettings.TimeSeparator + IntToStr(Min) +
|
||||
DefaultFormatSettings.TimeSeparator + IntToStr(Sec);
|
||||
raise EConvertError.CreateFmt(SInvalidTime, [sTime]);
|
||||
end;
|
||||
|
||||
function VertEquiv(l: Integer): Integer;
|
||||
begin
|
||||
VertEquiv := Longint(l) * AspectV div AspectH;
|
||||
end;
|
||||
|
||||
function HorzEquiv(l: Integer): Integer;
|
||||
begin
|
||||
HorzEquiv := Longint(l) * AspectH div AspectV;
|
||||
end;
|
||||
|
||||
function LightColor(Color: TColor): TColor;
|
||||
var
|
||||
L: Longint;
|
||||
C: array[1..3] of Byte;
|
||||
I: Byte;
|
||||
begin
|
||||
L := ColorToRGB(Color);
|
||||
C[1] := GetRValue(L);
|
||||
C[2] := GetGValue(L);
|
||||
C[3] := GetBValue(L);
|
||||
for I := 1 to 3 do
|
||||
begin
|
||||
if C[I] = $FF then
|
||||
begin
|
||||
Result := clBtnHighlight;
|
||||
Exit;
|
||||
end;
|
||||
if C[I] <> 0 then
|
||||
if C[I] = $C0 then C[I] := $FF
|
||||
else C[I] := C[I] + $7F;
|
||||
end;
|
||||
Result := TColor(RGB(C[1], C[2], C[3]));
|
||||
end;
|
||||
|
||||
procedure ClockInit;
|
||||
var
|
||||
Pos: Integer; { hand position Index into the circle table }
|
||||
vSize: Integer; { height of the display in millimeters }
|
||||
hSize: Integer; { width of the display in millimeters }
|
||||
DC: HDC;
|
||||
begin
|
||||
DC := GetDC(0);
|
||||
try
|
||||
VRes := GetDeviceCaps(DC, VERTRES);
|
||||
HRes := GetDeviceCaps(DC, HORZRES);
|
||||
vSize := GetDeviceCaps(DC, VERTSIZE);
|
||||
hSize := GetDeviceCaps(DC, HORZSIZE);
|
||||
finally
|
||||
ReleaseDC(0, DC);
|
||||
end;
|
||||
AspectV := (Longint(VRes) * MmPerDm) div Longint(vSize);
|
||||
AspectH := (Longint(HRes) * MmPerDm) div Longint(hSize);
|
||||
CircleTab := PPointArray(@ClockData);
|
||||
for Pos := 0 to HandPositions - 1 do
|
||||
CircleTab^[Pos].Y := VertEquiv(CircleTab^[Pos].Y);
|
||||
end;
|
||||
|
||||
function HourHandPos(T: TRxClockTime): Integer;
|
||||
begin
|
||||
Result := (T.Hour * 5) + (T.Minute div 12);
|
||||
end;
|
||||
|
||||
{ Digital clock font routine }
|
||||
|
||||
procedure SetNewFontSize(Canvas: TCanvas; const Text: string;
|
||||
MaxH, MaxW: Integer);
|
||||
const
|
||||
fHeight = 1000;
|
||||
var
|
||||
Font: TFont;
|
||||
NewH: Integer;
|
||||
begin
|
||||
Font := Canvas.Font;
|
||||
{ empiric calculate character height by cell height }
|
||||
MaxH := MulDiv(MaxH, 4, 5);
|
||||
{ with Font do
|
||||
begin}
|
||||
Font.Height := -fHeight;
|
||||
NewH := MulDiv(fHeight, MaxW, Canvas.TextWidth(Text));
|
||||
if NewH > MaxH then NewH := MaxH;
|
||||
Font.Height := -NewH;
|
||||
// end;
|
||||
end;
|
||||
|
||||
{ TRxClock }
|
||||
|
||||
constructor TRxClock.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
if not Registered then begin
|
||||
ClockInit;
|
||||
Registered := True;
|
||||
end;
|
||||
Caption := TimeToStr(Time);
|
||||
ControlStyle := ControlStyle - [csSetCaption] - [csReplicatable];
|
||||
BevelInner := bvLowered;
|
||||
BevelOuter := bvRaised;
|
||||
FTimer := TTimer.Create(Self);
|
||||
FTimer.Interval := 450; { every second }
|
||||
FTimer.OnTimer := @TimerExpired;
|
||||
FDotsColor := clTeal;
|
||||
FShowSeconds := True;
|
||||
FLeadingZero := True;
|
||||
GetTime(FDisplayTime);
|
||||
if FDisplayTime.Hour >= 12 then Dec(FDisplayTime.Hour, 12);
|
||||
FAlarmWait := True;
|
||||
FAlarm := EncodeTime(0, 0, 0, 0);
|
||||
end;
|
||||
|
||||
destructor TRxClock.Destroy;
|
||||
begin
|
||||
if FHooked then
|
||||
begin
|
||||
// Application.UnhookMainWindow(FormatSettingsChange);
|
||||
FHooked := False;
|
||||
end;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TRxClock.Loaded;
|
||||
begin
|
||||
inherited Loaded;
|
||||
ResetAlarm;
|
||||
end;
|
||||
|
||||
procedure TRxClock.CreateWnd;
|
||||
begin
|
||||
inherited CreateWnd;
|
||||
if not (csDesigning in ComponentState) and not (IsLibrary or FHooked) then
|
||||
begin
|
||||
// Application.HookMainWindow(FormatSettingsChange);
|
||||
FHooked := True;
|
||||
end;
|
||||
end;
|
||||
|
||||
{procedure TRxClock.DestroyWindowHandle;
|
||||
begin
|
||||
if FHooked then begin
|
||||
Application.UnhookMainWindow(FormatSettingsChange);
|
||||
FHooked := False;
|
||||
end;
|
||||
inherited DestroyWindowHandle;
|
||||
end;
|
||||
}
|
||||
{
|
||||
procedure TRxClock.CMCtl3DChanged(var Message: TMessage);
|
||||
begin
|
||||
inherited;
|
||||
if ShowMode = scAnalog then Invalidate;
|
||||
end;
|
||||
}
|
||||
procedure TRxClock.CMTextChanged(var Message: TMessage);
|
||||
begin
|
||||
{ Skip this message, no repaint }
|
||||
end;
|
||||
|
||||
procedure TRxClock.CMFontChanged(var Message: TMessage);
|
||||
begin
|
||||
inherited;
|
||||
Invalidate;
|
||||
if AutoSize then Realign;
|
||||
end;
|
||||
|
||||
{$IFDEF windows}
|
||||
procedure TRxClock.WMTimeChange(var Message: TMessage);
|
||||
begin
|
||||
inherited;
|
||||
Invalidate;
|
||||
CheckAlarm;
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
function TRxClock.FormatSettingsChange(var Message: TMessage): Boolean;
|
||||
begin
|
||||
{$IFDEF windows}
|
||||
Result := False;
|
||||
case Message.Msg of
|
||||
WM_WININICHANGE:
|
||||
begin
|
||||
Invalidate;
|
||||
if AutoSize then Realign;
|
||||
end;
|
||||
end;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function TRxClock.GetSystemTime: TDateTime;
|
||||
begin
|
||||
Result := SysUtils.Time;
|
||||
if Assigned(FOnGetTime) then FOnGetTime(Self, Result);
|
||||
end;
|
||||
|
||||
procedure TRxClock.GetTime(var T: TRxClockTime);
|
||||
var
|
||||
MSec: Word;
|
||||
begin
|
||||
with T do
|
||||
DecodeTime(GetSystemTime, Hour, Minute, Second, MSec);
|
||||
end;
|
||||
|
||||
procedure TRxClock.UpdateClock;
|
||||
begin
|
||||
Invalidate;
|
||||
if AutoSize then Realign;
|
||||
Update;
|
||||
end;
|
||||
|
||||
procedure TRxClock.ResetAlarm;
|
||||
begin
|
||||
FAlarmWait := (FAlarm > GetSystemTime) or (FAlarm = 0);
|
||||
end;
|
||||
|
||||
function TRxClock.IsAlarmTime(ATime: TDateTime): Boolean;
|
||||
var
|
||||
Hour, Min, Sec, MSec: Word;
|
||||
AHour, AMin, ASec: Word;
|
||||
begin
|
||||
DecodeTime(FAlarm, Hour, Min, Sec, MSec);
|
||||
DecodeTime(ATime, AHour, AMin, ASec, MSec);
|
||||
Result := {FAlarmWait and} (Hour = AHour) and (Min = AMin) and
|
||||
(ASec >= Sec) and (ASec <= Sec + AlarmSecDelay);
|
||||
end;
|
||||
|
||||
procedure TRxClock.ResizeFont(const Rect: TRect);
|
||||
var
|
||||
H, W: Integer;
|
||||
DC: HDC;
|
||||
TimeStr: string;
|
||||
begin
|
||||
H := Rect.Bottom - Rect.Top - 4;
|
||||
W := (Rect.Right - Rect.Left - 30);
|
||||
if (H <= 0) or (W <= 0) then Exit;
|
||||
DC := GetDC(0);
|
||||
try
|
||||
Canvas.Handle := DC;
|
||||
Canvas.Font := Font;
|
||||
TimeStr := '88888';
|
||||
if FShowSeconds then TimeStr := TimeStr + '888';
|
||||
if FTwelveHour then begin
|
||||
if Canvas.TextWidth(DefaultFormatSettings.TimeAMString) > Canvas.TextWidth(DefaultFormatSettings.TimePMString) then
|
||||
TimeStr := TimeStr + ' ' + DefaultFormatSettings.TimeAMString
|
||||
else TimeStr := TimeStr + ' ' + DefaultFormatSettings.TimePMString;
|
||||
end;
|
||||
SetNewFontSize(Canvas, TimeStr, H, W);
|
||||
Font := Canvas.Font;
|
||||
finally
|
||||
Canvas.Handle := 0;
|
||||
ReleaseDC(0, DC);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRxClock.AlignControls(AControl: TControl; var Rect: TRect);
|
||||
{$IFDEF RX_D4}
|
||||
var
|
||||
InflateWidth: Integer;
|
||||
{$ENDIF}
|
||||
begin
|
||||
inherited AlignControls(AControl, Rect);
|
||||
FClockRect := Rect;
|
||||
{$IFDEF RX_D4}
|
||||
InflateWidth := BorderWidth + 1;
|
||||
if BevelOuter <> bvNone then Inc(InflateWidth, BevelWidth);
|
||||
if BevelInner <> bvNone then Inc(InflateWidth, BevelWidth);
|
||||
InflateRect(FClockRect, -InflateWidth, -InflateWidth);
|
||||
{$ENDIF}
|
||||
with FClockRect do CircleClock(Right - Left, Bottom - Top);
|
||||
if AutoSize then ResizeFont(Rect);
|
||||
end;
|
||||
|
||||
procedure TRxClock.Alarm;
|
||||
begin
|
||||
if Assigned(FOnAlarm) then FOnAlarm(Self);
|
||||
end;
|
||||
|
||||
procedure TRxClock.SetAutoSize(const Value: Boolean);
|
||||
begin
|
||||
if (Value <> FAutoSize) then
|
||||
begin
|
||||
FAutoSize := Value;
|
||||
if FAutoSize then
|
||||
begin
|
||||
Invalidate;
|
||||
Realign;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRxClock.SetTwelveHour(Value: Boolean);
|
||||
begin
|
||||
if FTwelveHour <> Value then begin
|
||||
FTwelveHour := Value;
|
||||
Invalidate;
|
||||
if AutoSize then Realign;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRxClock.SetLeadingZero(Value: Boolean);
|
||||
begin
|
||||
if FLeadingZero <> Value then begin
|
||||
FLeadingZero := Value;
|
||||
Invalidate;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRxClock.SetShowSeconds(Value: Boolean);
|
||||
begin
|
||||
if FShowSeconds <> Value then begin
|
||||
{if FShowSeconds and (ShowMode = scAnalog) then
|
||||
DrawSecondHand(FDisplayTime.Second);}
|
||||
FShowSeconds := Value;
|
||||
Invalidate;
|
||||
if AutoSize then Realign;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRxClock.SetDotsColor(Value: TColor);
|
||||
begin
|
||||
if Value <> FDotsColor then begin
|
||||
FDotsColor := Value;
|
||||
Invalidate;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRxClock.SetShowMode(Value: TShowClock);
|
||||
begin
|
||||
if FShowMode <> Value then begin
|
||||
FShowMode := Value;
|
||||
Invalidate;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TRxClock.GetAlarmElement(Index: Integer): Byte;
|
||||
var
|
||||
Hour, Min, Sec, MSec: Word;
|
||||
begin
|
||||
DecodeTime(FAlarm, Hour, Min, Sec, MSec);
|
||||
case Index of
|
||||
1: Result := Hour;
|
||||
2: Result := Min;
|
||||
3: Result := Sec;
|
||||
else Result := 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRxClock.SetAlarmElement(Index: Integer; Value: Byte);
|
||||
var
|
||||
Hour, Min, Sec, MSec: Word;
|
||||
begin
|
||||
DecodeTime(FAlarm, Hour, Min, Sec, MSec);
|
||||
case Index of
|
||||
1: Hour := Value;
|
||||
2: Min := Value;
|
||||
3: Sec := Value;
|
||||
else Exit;
|
||||
end;
|
||||
if (Hour < 24) and (Min < 60) and (Sec < 60) then begin
|
||||
FAlarm := EncodeTime(Hour, Min, Sec, 0);
|
||||
ResetAlarm;
|
||||
end
|
||||
else InvalidTime(Hour, Min, Sec);
|
||||
end;
|
||||
|
||||
procedure TRxClock.SetAlarmTime(AlarmTime: TDateTime);
|
||||
var
|
||||
Hour, Min, Sec, MSec: Word;
|
||||
begin
|
||||
DecodeTime(FAlarm, Hour, Min, Sec, MSec);
|
||||
if (Hour < 24) and (Min < 60) and (Sec < 60) then begin
|
||||
FAlarm := Frac(AlarmTime);
|
||||
ResetAlarm;
|
||||
end
|
||||
else InvalidTime(Hour, Min, Sec);
|
||||
end;
|
||||
|
||||
procedure TRxClock.TimerExpired(Sender: TObject);
|
||||
var
|
||||
DC: HDC;
|
||||
Rect: TRect;
|
||||
InflateWidth: Integer;
|
||||
begin
|
||||
DC := GetDC(Handle);
|
||||
try
|
||||
Canvas.Handle := DC;
|
||||
Canvas.Brush.Color := Color;
|
||||
Canvas.Font := Font;
|
||||
Canvas.Pen.Color := Font.Color;
|
||||
if FShowMode = scAnalog then PaintAnalogClock(pmHandPaint)
|
||||
else begin
|
||||
Rect := GetClientRect;
|
||||
InflateWidth := BorderWidth;
|
||||
if BevelOuter <> bvNone then Inc(InflateWidth, BevelWidth);
|
||||
if BevelInner <> bvNone then Inc(InflateWidth, BevelWidth);
|
||||
InflateRect(Rect, -InflateWidth, -InflateWidth);
|
||||
PaintTimeStr(Rect, False);
|
||||
end;
|
||||
finally
|
||||
Canvas.Handle := 0;
|
||||
ReleaseDC(Handle, DC);
|
||||
end;
|
||||
CheckAlarm;
|
||||
end;
|
||||
|
||||
procedure TRxClock.CheckAlarm;
|
||||
begin
|
||||
if FAlarmEnabled and IsAlarmTime(GetSystemTime) then begin
|
||||
if FAlarmWait then begin
|
||||
FAlarmWait := False;
|
||||
Alarm;
|
||||
end;
|
||||
end
|
||||
else ResetAlarm;
|
||||
end;
|
||||
|
||||
procedure TRxClock.DrawAnalogFace;
|
||||
var
|
||||
Pos, DotHeight, DotWidth: Integer;
|
||||
DotCenter: TPoint;
|
||||
R: TRect;
|
||||
SaveBrush, SavePen: TColor;
|
||||
MinDots: Boolean;
|
||||
begin
|
||||
DotWidth := (MaxDotWidth * Longint(FClockRect.Right - FClockRect.Left)) div HRes;
|
||||
DotHeight := VertEquiv(DotWidth);
|
||||
if DotHeight < MinDotHeight then DotHeight := MinDotHeight;
|
||||
if DotWidth < MinDotWidth then DotWidth := MinDotWidth;
|
||||
DotCenter.X := DotWidth div 2;
|
||||
DotCenter.Y := DotHeight div 2;
|
||||
InflateRect(FClockRect, -DotCenter.Y, -DotCenter.X);
|
||||
FClockRadius := ((FClockRect.Right - FClockRect.Left) div 2);
|
||||
FClockCenter.X := FClockRect.Left + FClockRadius;
|
||||
FClockCenter.Y := FClockRect.Top + ((FClockRect.Bottom - FClockRect.Top) div 2);
|
||||
InflateRect(FClockRect, DotCenter.Y, DotCenter.X);
|
||||
SaveBrush := Canvas.Brush.Color;
|
||||
SavePen := Canvas.Pen.Color;
|
||||
try
|
||||
Canvas.Brush.Color := Canvas.Pen.Color;
|
||||
MinDots := ((DotWidth > MinDotWidth) and (DotHeight > MinDotHeight));
|
||||
for Pos := 0 to HandPositions - 1 do
|
||||
begin
|
||||
R.Top := (CircleTab^[Pos].Y * FClockRadius) div CirTabScale + FClockCenter.Y;
|
||||
R.Left := (CircleTab^[Pos].X * FClockRadius) div CirTabScale + FClockCenter.X;
|
||||
if (Pos mod 5) <> 0 then
|
||||
begin
|
||||
if MinDots then
|
||||
begin
|
||||
// if Ctl3D then
|
||||
begin
|
||||
Canvas.Brush.Color := clBtnShadow;
|
||||
OffsetRect(R, -1, -1);
|
||||
R.Right := R.Left + 2;
|
||||
R.Bottom := R.Top + 2;
|
||||
Canvas.FillRect(R);
|
||||
Canvas.Brush.Color := clBtnHighlight;
|
||||
OffsetRect(R, 1, 1);
|
||||
Canvas.FillRect(R);
|
||||
Canvas.Brush.Color := Self.Color;
|
||||
end;
|
||||
R.Right := R.Left + 1;
|
||||
R.Bottom := R.Top + 1;
|
||||
Canvas.FillRect(R);
|
||||
end;
|
||||
end
|
||||
else begin
|
||||
R.Right := R.Left + DotWidth;
|
||||
R.Bottom := R.Top + DotHeight;
|
||||
OffsetRect(R, -DotCenter.X, -DotCenter.Y);
|
||||
if {Ctl3D and} MinDots then
|
||||
with Canvas do
|
||||
begin
|
||||
Brush.Color := FDotsColor;
|
||||
Brush.Style := bsSolid;
|
||||
FillRect(R);
|
||||
RxFrame3D(Canvas, R, LightColor(FDotsColor), clWindowFrame, 1);
|
||||
end;
|
||||
Canvas.Brush.Color := Canvas.Pen.Color;
|
||||
if not ({Ctl3D and} MinDots) then Canvas.FillRect(R);
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
Canvas.Brush.Color := SaveBrush;
|
||||
Canvas.Pen.Color := SavePen;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRxClock.CircleClock(MaxWidth, MaxHeight: Integer);
|
||||
var
|
||||
ClockHeight: Integer;
|
||||
ClockWidth: Integer;
|
||||
begin
|
||||
if MaxWidth > HorzEquiv(MaxHeight) then begin
|
||||
ClockWidth := HorzEquiv(MaxHeight);
|
||||
FClockRect.Left := FClockRect.Left + ((MaxWidth - ClockWidth) div 2);
|
||||
FClockRect.Right := FClockRect.Left + ClockWidth;
|
||||
end
|
||||
else begin
|
||||
ClockHeight := VertEquiv(MaxWidth);
|
||||
FClockRect.Top := FClockRect.Top + ((MaxHeight - ClockHeight) div 2);
|
||||
FClockRect.Bottom := FClockRect.Top + ClockHeight;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRxClock.DrawSecondHand(Pos: Integer);
|
||||
var
|
||||
Radius: Longint;
|
||||
SaveMode: TPenMode;
|
||||
begin
|
||||
Radius := (FClockRadius * SecondTip) div 100;
|
||||
SaveMode := Canvas.Pen.Mode;
|
||||
Canvas.Pen.Mode := pmNot;
|
||||
try
|
||||
Canvas.MoveTo(FClockCenter.X, FClockCenter.Y);
|
||||
Canvas.LineTo(FClockCenter.X + ((CircleTab^[Pos].X * Radius) div
|
||||
CirTabScale), FClockCenter.Y + ((CircleTab^[Pos].Y * Radius) div
|
||||
CirTabScale));
|
||||
finally
|
||||
Canvas.Pen.Mode := SaveMode;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRxClock.DrawFatHand(Pos: Integer; HourHand: Boolean);
|
||||
var
|
||||
ptSide, ptTail, ptTip: TPoint;
|
||||
Index, Hand: Integer;
|
||||
Scale: Longint;
|
||||
SaveMode: TPenMode;
|
||||
begin
|
||||
if HourHand then Hand := HourSide else Hand := MinuteSide;
|
||||
Scale := (FClockRadius * Hand) div 100;
|
||||
Index := (Pos + SideShift) mod HandPositions;
|
||||
ptSide.Y := (CircleTab^[Index].Y * Scale) div CirTabScale;
|
||||
ptSide.X := (CircleTab^[Index].X * Scale) div CirTabScale;
|
||||
if HourHand then Hand := HourTip else Hand := MinuteTip;
|
||||
Scale := (FClockRadius * Hand) div 100;
|
||||
ptTip.Y := (CircleTab^[Pos].Y * Scale) div CirTabScale;
|
||||
ptTip.X := (CircleTab^[Pos].X * Scale) div CirTabScale;
|
||||
if HourHand then Hand := HourTail else Hand := MinuteTail;
|
||||
Scale := (FClockRadius * Hand) div 100;
|
||||
Index := (Pos + TailShift) mod HandPositions;
|
||||
ptTail.Y := (CircleTab^[Index].Y * Scale) div CirTabScale;
|
||||
ptTail.X := (CircleTab^[Index].X * Scale) div CirTabScale;
|
||||
with Canvas do begin
|
||||
SaveMode := Pen.Mode;
|
||||
Pen.Mode := pmCopy;
|
||||
try
|
||||
MoveTo(FClockCenter.X + ptSide.X, FClockCenter.Y + ptSide.Y);
|
||||
LineTo(FClockCenter.X + ptTip.X, FClockCenter.Y + ptTip.Y);
|
||||
MoveTo(FClockCenter.X - ptSide.X, FClockCenter.Y - ptSide.Y);
|
||||
LineTo(FClockCenter.X + ptTip.X, FClockCenter.Y + ptTip.Y);
|
||||
MoveTo(FClockCenter.X + ptSide.X, FClockCenter.Y + ptSide.Y);
|
||||
LineTo(FClockCenter.X + ptTail.X, FClockCenter.Y + ptTail.Y);
|
||||
MoveTo(FClockCenter.X - ptSide.X, FClockCenter.Y - ptSide.Y);
|
||||
LineTo(FClockCenter.X + ptTail.X, FClockCenter.Y + ptTail.Y);
|
||||
finally
|
||||
Pen.Mode := SaveMode;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRxClock.PaintAnalogClock(PaintMode: TPaintMode);
|
||||
var
|
||||
NewTime: TRxClockTime;
|
||||
begin
|
||||
Canvas.Pen.Color := Font.Color;
|
||||
Canvas.Brush.Color := Color;
|
||||
SetBkMode(Canvas.Handle, TRANSPARENT);
|
||||
if PaintMode = pmPaintAll then
|
||||
begin
|
||||
with Canvas do
|
||||
begin
|
||||
FillRect(FClockRect);
|
||||
Pen.Color := Self.Font.Color;
|
||||
DrawAnalogFace;
|
||||
DrawFatHand(HourHandPos(FDisplayTime), True);
|
||||
DrawFatHand(FDisplayTime.Minute, False);
|
||||
Pen.Color := Brush.Color;
|
||||
if ShowSeconds then
|
||||
DrawSecondHand(FDisplayTime.Second);
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
with Canvas do
|
||||
begin
|
||||
Pen.Color := Brush.Color;
|
||||
GetTime(NewTime);
|
||||
if NewTime.Hour >= 12 then
|
||||
Dec(NewTime.Hour, 12);
|
||||
if (NewTime.Second <> FDisplayTime.Second) then
|
||||
if ShowSeconds then
|
||||
DrawSecondHand(FDisplayTime.Second);
|
||||
if ((NewTime.Minute <> FDisplayTime.Minute) or
|
||||
(NewTime.Hour <> FDisplayTime.Hour)) then
|
||||
begin
|
||||
DrawFatHand(FDisplayTime.Minute, False);
|
||||
DrawFatHand(HourHandPos(FDisplayTime), True);
|
||||
Pen.Color := Self.Font.Color;
|
||||
DrawFatHand(NewTime.Minute, False);
|
||||
DrawFatHand(HourHandPos(NewTime), True);
|
||||
end;
|
||||
Pen.Color := Brush.Color;
|
||||
if (NewTime.Second <> FDisplayTime.Second) then
|
||||
begin
|
||||
if ShowSeconds then
|
||||
DrawSecondHand(NewTime.Second);
|
||||
FDisplayTime := NewTime;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRxClock.PaintTimeStr(var Rect: TRect; FullTime: Boolean);
|
||||
var
|
||||
FontHeight, FontWidth, FullWidth, I, L, H: Integer;
|
||||
TimeStr, SAmPm: string;
|
||||
NewTime: TRxClockTime;
|
||||
|
||||
function IsPartSym(Idx, Num: Byte): Boolean;
|
||||
var
|
||||
TwoSymHour: Boolean;
|
||||
begin
|
||||
TwoSymHour := (H >= 10) or FLeadingZero;
|
||||
case Idx of
|
||||
1: begin {hours}
|
||||
Result := True;
|
||||
end;
|
||||
2: begin {minutes}
|
||||
if TwoSymHour then Result := (Num in [4, 5])
|
||||
else Result := (Num in [3, 4]);
|
||||
end;
|
||||
3: begin {seconds}
|
||||
if TwoSymHour then Result := FShowSeconds and (Num in [7, 8])
|
||||
else Result := FShowSeconds and (Num in [6, 7]);
|
||||
end;
|
||||
else Result := False;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure DrawSym(Sym: Char; Num: Byte);
|
||||
begin
|
||||
if FullTime or
|
||||
((NewTime.Second <> FDisplayTime.Second) and IsPartSym(3, Num)) or
|
||||
((NewTime.Minute <> FDisplayTime.Minute) and IsPartSym(2, Num)) or
|
||||
(NewTime.Hour <> FDisplayTime.Hour) then
|
||||
begin
|
||||
Canvas.FillRect(Rect);
|
||||
DrawText(Canvas.Handle, @Sym, 1, Rect, DT_EXPANDTABS or
|
||||
DT_VCENTER or DT_CENTER or DT_NOCLIP or DT_SINGLELINE);
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
GetTime(NewTime);
|
||||
H := NewTime.Hour;
|
||||
if NewTime.Hour >= 12 then Dec(NewTime.Hour, 12);
|
||||
if FTwelveHour then begin
|
||||
if H > 12 then Dec(H, 12) else if H = 0 then H := 12;
|
||||
end;
|
||||
if (not FullTime) and (NewTime.Hour <> FDisplayTime.Hour) then begin
|
||||
Repaint;
|
||||
Exit;
|
||||
end;
|
||||
if FLeadingZero then TimeStr := 'hh:mm' else TimeStr := 'h:mm';
|
||||
if FShowSeconds then TimeStr := TimeStr + ':ss';
|
||||
if FTwelveHour then TimeStr := TimeStr + ' ampm';
|
||||
with NewTime do
|
||||
TimeStr := FormatDateTime(TimeStr, GetSystemTime);
|
||||
if (H >= 10) or FLeadingZero then L := 5 else L := 4;
|
||||
if FShowSeconds then Inc(L, 3);
|
||||
SAmPm := Copy(TimeStr, L + 1, MaxInt);
|
||||
with Canvas do begin
|
||||
Font := Self.Font;
|
||||
FontHeight := TextHeight('8');
|
||||
FontWidth := TextWidth('8');
|
||||
FullWidth := TextWidth(SAmPm) + (L * FontWidth);
|
||||
with Rect do begin
|
||||
Left := ((Right + Left) - FullWidth) div 2 {shr 1};
|
||||
Right := Left + FullWidth;
|
||||
Top := ((Bottom + Top) - FontHeight) div 2 {shr 1};
|
||||
Bottom := Top + FontHeight;
|
||||
end;
|
||||
Brush.Color := Color;
|
||||
for I := 1 to L do begin
|
||||
Rect.Right := Rect.Left + FontWidth;
|
||||
DrawSym(TimeStr[I], I);
|
||||
Inc(Rect.Left, FontWidth);
|
||||
end;
|
||||
if FullTime or (NewTime.Hour <> FDisplayTime.Hour) then begin
|
||||
Rect.Right := Rect.Left + TextWidth(SAmPm);
|
||||
DrawText(Handle, @SAmPm[1], Length(SAmPm), Rect,
|
||||
DT_EXPANDTABS or DT_VCENTER or DT_NOCLIP or DT_SINGLELINE);
|
||||
end;
|
||||
end;
|
||||
FDisplayTime := NewTime;
|
||||
end;
|
||||
|
||||
procedure TRxClock.Paint3DFrame(var Rect: TRect);
|
||||
var
|
||||
TopColor, BottomColor: TColor;
|
||||
|
||||
procedure AdjustColors(Bevel: TPanelBevel);
|
||||
begin
|
||||
TopColor := clBtnHighlight;
|
||||
if Bevel = bvLowered then TopColor := clBtnShadow;
|
||||
BottomColor := clBtnShadow;
|
||||
if Bevel = bvLowered then BottomColor := clBtnHighlight;
|
||||
end;
|
||||
|
||||
begin
|
||||
Rect := GetClientRect;
|
||||
with Canvas do
|
||||
begin
|
||||
Brush.Color := Color;
|
||||
FillRect(Rect);
|
||||
end;
|
||||
if BevelOuter <> bvNone then
|
||||
begin
|
||||
AdjustColors(BevelOuter);
|
||||
RxFrame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
|
||||
end;
|
||||
InflateRect(Rect, -BorderWidth, -BorderWidth);
|
||||
if BevelInner <> bvNone then
|
||||
begin
|
||||
AdjustColors(BevelInner);
|
||||
RxFrame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRxClock.Paint;
|
||||
var
|
||||
R: TRect;
|
||||
begin
|
||||
Paint3DFrame(R);
|
||||
case FShowMode of
|
||||
scDigital: PaintTimeStr(R, True);
|
||||
scAnalog: PaintAnalogClock(pmPaintAll);
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user