jvclock.pas

East make Tray Icon in delphi

  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
  {$IFDEF VCL}
  if FHooked then
  begin
    Application.UnhookMainWindow(FormatSettingsChange);
    FHooked := False;
  end;
  {$ENDIF VCL}
  inherited Destroy;
end;

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

{$IFDEF VCL}

procedure TJvClock.CreateWnd;
begin
  inherited CreateWnd;
  if not (csDesigning in ComponentState) and not (IsLibrary or FHooked) then
  begin
    Application.HookMainWindow(FormatSettingsChange);
    FHooked := True;
  end;
end;

procedure TJvClock.DestroyWindowHandle;
begin
  if FHooked then
  begin
    Application.UnhookMainWindow(FormatSettingsChange);
    FHooked := False;
  end;
  inherited DestroyWindowHandle;
end;

procedure TJvClock.CMCtl3DChanged(var Msg: TMessage);
begin
  inherited;
  if ShowMode = scAnalog then
    Invalidate;
end;

{$ENDIF VCL}

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

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

{$IFDEF VCL}

procedure TJvClock.WMTimeChange(var Msg: TMessage);
begin
  inherited;
  Invalidate;
  CheckAlarm;
end;

function TJvClock.FormatSettingsChange(var Msg: TMessage): Boolean;
begin
  Result := False;
  case Msg.Msg of
    WM_WININICHANGE:
      begin
        Invalidate;
        if AutoSize then
          Realign;
      end;
  end;
end;

{$ENDIF VCL}

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
    {$IFDEF VCL}
    Canvas.Handle := 0;
    {$ENDIF VCL}
    {$IFDEF VisualCLX}
    Canvas.Handle := nil;
    {$ENDIF VisualCLX}
    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
  {$IFDEF VCL}
  {$IFDEF COMPILER6_UP}
  inherited SetAutoSize(Value);
  {$ENDIF COMPILER6_UP}
  {$ENDIF VCL}
  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;
end;

procedure TJvClock.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 TJvClock.SetDotsColor(Value: TColor);
begin
  if Value <> FDotsColor then
  begin
    FDotsColor := Value;
    Invalidate;
  end;
end;

procedure TJvClock.SetShowMode(Value: TShowClock);
begin
  if FShowMode <> Value then
  begin
    FShowMode := Value;
    Invalidate;
  end;
end;

function TJvClock.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 TJvClock.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 TJvClock.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 TJvClock.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 := NullHandle;
    ReleaseDC(Handle, DC);
  end;
  CheckAlarm;
end;

procedure TJvClock.CheckAlarm;
begin
  if FAlarmEnabled and IsAlarmTime(GetSystemTime) then
  begin
    if FAlarmWait then
    begin
      FAlarmWait := False;
      Alarm;
    end;
  end
  else
    ResetAlarm;
end;

procedure TJvClock.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);