jvqclock.pas

East make Tray Icon in delphi

{******************************************************************************}
{* WARNING:  JEDI VCL To CLX Converter generated unit.                        *}
{*           Manual modifications will be lost on next release.               *}
{******************************************************************************}

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvClock.PAS, released on 2002-07-04.

The Initial Developers of the Original Code are: Fedor Koshevnikov, Igor Pavluk and Serge Korolev
Copyright (c) 1997, 1998 Fedor Koshevnikov, Igor Pavluk and Serge Korolev
Copyright (c) 2001,2002 SGB Software
All Rights Reserved.

Contributor(s):
  Polaris Software

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvQClock.pas,v 1.15 2005/02/06 14:06:02 asnepvangers Exp $

unit JvQClock;

{$I jvcl.inc}

interface

uses
  QWindows, QMessages, Classes, QGraphics, QControls,
  JvQJCLUtils, JvQTimer, JvQComponent, JvQExControls;

type
  TShowClock = (scDigital, scAnalog);
  TPaintMode = (pmPaintAll, pmHandPaint);

  TJvClockTime = packed record
    Hour: Word;
    Minute: Word;
    Second: Word;
  end;

  TJvGetTimeEvent = procedure(Sender: TObject; var ATime: TDateTime) of object;

  TJvClock = class(TJvCustomPanel, IJvDenySubClassing)
  private
    FTimer: TJvTimer;
    FAutoSize: Boolean;
    FShowMode: TShowClock;
    FTwelveHour: Boolean;
    FLeadingZero: Boolean;
    FShowSeconds: Boolean;
    FAlarm: TDateTime;
    FAlarmEnabled: Boolean; 
    FDotsColor: TColor;
    FAlarmWait: Boolean;
    FDisplayTime: TJvClockTime;
    FClockRect: TRect;
    FClockRadius: Longint;
    FClockCenter: TPoint;
    FOnGetTime: TJvGetTimeEvent;
    FOnAlarm: TNotifyEvent;
    procedure TimerExpired(Sender: TObject);
    procedure GetTime(var T: TJvClockTime);
    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; 
  protected
    procedure TextChanged; override;
    procedure FontChanged; override;
    procedure SetAutoSize(Value: Boolean); 
    procedure Alarm; dynamic;
    procedure AlignControls(AControl: TControl; var Rect: TRect); override; 
    procedure Loaded; override;
    procedure Paint; override;
    function GetSystemTime: TDateTime; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetAlarmTime(AlarmTime: TDateTime);
    procedure UpdateClock;
  published
    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;
    property Anchors;
    property Constraints; 
    property Color;
    property Cursor;
    property DragMode;
    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: TJvGetTimeEvent 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 OnConstrainedResize; 
  end;

implementation

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  {$IFDEF HAS_UNIT_RTLCONSTS}
  RTLConsts,
  {$ENDIF HAS_UNIT_RTLCONSTS} 
  SysConst, 
  SysUtils, QForms, QExtCtrls, QConsts,
  JvQThemes;

var
  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) + TimeSeparator + IntToStr(Min) +
    TimeSeparator + IntToStr(Sec);
  raise EConvertError.CreateResFmt(@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(HWND_DESKTOP);
  try
    VRes := GetDeviceCaps(DC, VERTRES);
    HRes := GetDeviceCaps(DC, HORZRES);
    vSize := GetDeviceCaps(DC, VERTSIZE);
    hSize := GetDeviceCaps(DC, HORZSIZE);
  finally
    ReleaseDC(HWND_DESKTOP, 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: TJvClockTime): 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
    Height := -FHeight;
    NewH := MulDiv(FHeight, MaxW, Canvas.TextWidth(Text));
    if NewH > MaxH then
      NewH := MaxH;
    Height := -NewH;
  end;
end;

constructor TJvClock.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 := TJvTimer.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 TJvClock.Destroy;
begin 
  inherited Destroy;
end;

procedure TJvClock.Loaded;
begin
  inherited Loaded;
  ResetAlarm;
end;



procedure TJvClock.TextChanged;
begin
  { Skip this message, no repaint }
end;

procedure TJvClock.FontChanged;
begin
  inherited FontChanged;
  Invalidate;
  if AutoSize then
    Realign;
end;



function TJvClock.GetSystemTime: TDateTime;
begin
  Result := SysUtils.Time;
  if Assigned(FOnGetTime) then
    FOnGetTime(Self, Result);
end;

procedure TJvClock.GetTime(var T: TJvClockTime);
var
  MSec: Word;
begin
  with T do
    DecodeTime(GetSystemTime, Hour, Minute, Second, MSec);
end;

procedure TJvClock.UpdateClock;
begin
  Invalidate;
  if AutoSize then
    Realign;
  Update;
end;

procedure TJvClock.ResetAlarm;
begin
  FAlarmWait := (FAlarm > GetSystemTime) or (FAlarm = 0);
end;

function TJvClock.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 TJvClock.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(HWND_DESKTOP);
  try
    Canvas.Handle := DC;
    Canvas.Font := Font;
    TimeStr := '88888';
    if FShowSeconds then
      TimeStr := TimeStr + '888';
    if FTwelveHour then
    begin
      if Canvas.TextWidth(TimeAMString) > Canvas.TextWidth(TimePMString) then
        TimeStr := TimeStr + ' ' + TimeAMString
      else
        TimeStr := TimeStr + ' ' + TimePMString;
    end;
    SetNewFontSize(Canvas, TimeStr, H, W);
    Font := Canvas.Font;
  finally  
    Canvas.Handle := nil; 
    ReleaseDC(HWND_DESKTOP, DC);
  end;
end;

procedure TJvClock.AlignControls(AControl: TControl; var Rect: TRect);
var
  InflateWidth: Integer;
begin
  inherited AlignControls(AControl, Rect);
  FClockRect := Rect;
  InflateWidth := BorderWidth + 1;
  if BevelOuter <> bvNone then
    Inc(InflateWidth, BevelWidth);
  if BevelInner <> bvNone then
    Inc(InflateWidth, BevelWidth);
  InflateRect(FClockRect, -InflateWidth, -InflateWidth);
  with FClockRect do
    CircleClock(Right - Left, Bottom - Top);
  if AutoSize then
    ResizeFont(Rect);
end;

procedure TJvClock.Alarm;
begin
  if Assigned(FOnAlarm) then
    FOnAlarm(Self);
end;

procedure TJvClock.SetAutoSize(Value: Boolean);
begin 
  FAutoSize := Value;
  if FAutoSize then
  begin
    Invalidate;
    Realign;
  end;
end;

procedure TJvClock.SetTwelveHour(Value: Boolean);
begin
  if FTwelveHour <> Value then
  begin
    FTwelveHour := Value;
    Invalidate;
    if AutoSize then
      Realign;
  end;
end;

procedure TJvClock.SetLeadingZero(Value: Boolean);
begin
  if FLeadingZero <> Value then
  begin
    FLeadingZero := Value;
    Invalidate;
  end;