rxclock.pas

灰鸽子1.23源码,,,,,,,

  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(Value: Boolean);
begin
  inherited SetAutoSize(Value);
  FAutoSize := Value;
  if FAutoSize then begin
    Invalidate;
    Realign;
  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);
            Frame3D(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);
    Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
  end;
  InflateRect(Rect, -BorderWidth, -BorderWidth);
  if BevelInner <> bvNone then begin
    AdjustColors(BevelInner);
    Frame3D(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.