Analog Saat Komponenti

Kod:

unit AnalogSaat;

interface
uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  ExtCtrls;

type
  Tsaat = class(TGraphicControl)
  private
    Ticker : TTimer; { }

    FPen: TPen;          { ok için kalem}
    FBitMap : TBitMap;   { arka görüntü için}
    { OnSecond, OnMinute, OnHour events(olaylar?)}
    Fsaniye, Fdakika, Fsaat : TNotifyEvent;

    { saatin degiskenlerini tanimladim}
    CenterPoint : TPoint; { okun merkezini olu?turdum}
    Radius : integer;     { saatin yar?çap?n? yapt?m}
    LapStepW : integer;   { her ad?mdaki tur için uzunlu?u ayar}
    PrevTime : TDateTime;
    SaniyeyiGoster: boolean; { saniye için oku göster}
    FArrowColor : TColor; { okun rengi}
    FFaceColor : TColor;  { saatin rengi}
    CsaatFarki, CdakikaFarki : integer; { sistem saatine uygunluk}

    procedure SetFaceColor( Value : TColor);
    procedure SetArrowColor( Value : TColor);
    procedure SetsaniyeyiGoster( Value : boolean);
    procedure SetsaatFarki( Value : integer);
    procedure SetdakikaFarki( Value : integer);


    function MinuteAngle( Min : word) : real;    { dakika okunun aç?s?}
    function HourAngle( Hou, Min : word) : real; { saat oku aç?s?}
    procedure saatAyarlari;
    procedure DrawClockBkg; { FBitMap ile saatin arkaplan?n? çizecem}
    procedure DrawArrows; { saatin oklar?n? çizecem}
    { saat fark? prosedürüm( GTime - DTime) }
    procedure ZamanFarki( GTime, DTime : TDateTime; var dHour, dMin : integer);
    procedure DecodeCTime( CTime : TDateTime; var H, M, S : word);

  protected
    procedure Paint; override;
    procedure TickerCall(Sender: TObject); { Timer event}

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ClkTime( var H, M, S : word); { sistem saatini alacam}
    procedure SetClkTime( CTime : TDateTime); { ve bunu saate uygulayacam}

  published
    property Align;
    property Enabled;
    property ParentShowHint;
    property ShowHint;
    property Visible;
    {}
    property ClkArrowColor : TColor read FArrowColor write SetArrowColor default clBlack;
    property ClkFaceColor : TColor read FFaceColor write SetFaceColor default clBtnFace;
    property saatFarki : integer read CsaatFarki write SetsaatFarki default 0;
    property dakikaFarki : integer read CdakikaFarki write SetdakikaFarki default 0;
    property saniyeOku : boolean read saniyeyiGoster write SetsaniyeyiGoster;
    property saniye : TNotifyEvent read Fsaniye write Fsaniye;
    property dakika : TNotifyEvent read Fdakika write Fdakika;
    property saat   : TNotifyEvent read Fsaat  write Fsaat;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents( 'AnalogSaat', [Tsaat]);
end;

const
  SecScale = 1;      SecThick = 1;
  MinScale = 0.95;   MinThick = 3;
  HouScale = 0.60;   HouThick = 6;

constructor Tsaat.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width := 66;  Height := 66;

  { private degiskenleri çagiriyrum ve bailatiyorum}

  FFaceColor := clBtnFace;
  FArrowColor := clBlack;

  PrevTime := 0;
  saniyeyiGoster := true;
  CsaatFarki := 0;
  CdakikaFarki := 0;

  { kalemi(peni)olusturdum}
  FPen := TPen.Create;
  {arkaplan için BitMap'i olustrdum}
  FBitMap := TBitMap.Create;
  FBitMap.Width := Width;
  FBitMap.Height := Height;
  { saati hem olusturdum hemde ayarladim}
  Ticker := TTimer.Create( Self);
  Ticker.Interval := 1000;
  Ticker.OnTimer := TickerCall;
  Ticker.Enabled := true;
end;

procedure Tsaat.SetFaceColor( Value : TColor);
begin
FFaceColor := Value;
invalidate;
end;

procedure Tsaat.SetArrowColor( Value : TColor);
begin FArrowColor := Value;
invalidate;
end;

procedure Tsaat.SetsaniyeyiGoster( Value : boolean);
begin
  saniyeyiGoster := Value;
  PrevTime := 0;
  Invalidate;
end;

procedure Tsaat.SetsaatFarki( Value : integer);
begin
  CsaatFarki := Value MOD 12;
  DrawArrows;
end;

procedure Tsaat.SetdakikaFarki( Value : integer);
begin
  CdakikaFarki := Value MOD 60;
  DrawArrows;
end;


procedure Tsaat.Paint;
begin
  saatAyarlari;
  DrawClockBkg;
  PrevTime := 0;
  DrawArrows;
end;

destructor Tsaat.Destroy;
begin
  FPen.Free;
  FBitMap.Free;
  Ticker.Free;
  inherited Destroy;
end;

procedure Tsaat.ZamanFarki( GTime, DTime : TDateTime; var dHour, dMin : integer);
var MinDiff : integer; GTMin, DTMin : integer;

  function Time2Min( Tim : TDateTime) : integer;
    var cH, cM, cS, cmS : word;
  begin
    DecodeTime( Tim, cH, cM, cS, cmS);  Result := cH * 60 + cM;
  end;

begin
  GTMin := Time2Min( GTime);
  DTMin := Time2Min( DTime);
  MinDiff :=  GTMin - DTMin;
  dHour := MinDiff DIV 60;
  dMin  := MinDiff MOD 60;
end;

{ Simdiki zamani al}
procedure Tsaat.DecodeCTime( CTime : TDateTime; var H, M, S : word);
var
  cH, cM, cS, cmS : word;
  SysMinAft0, TotMinDiff, ClkMinAft0 : integer;
begin
  DecodeTime( CTime, cH, cM, cS, cmS);
  SysMinAft0 := cH * 60 + cM;
  TotMinDiff := CsaatFarki * 60 + CdakikaFarki;
  ClkMinAft0 := SysMinAft0 + TotMinDiff;
  if ClkMinAft0 < 0 then ClkMinAft0 := 24 * 60 + ClkMinAft0;
  H := ClkMinAft0 DIV 60;
  M := ClkMinAft0 MOD 60;
  S := cS;
end;

procedure Tsaat.ClkTime( var H, M, S : word); { Get clock time}
begin
  DecodeCTime( Time, H, M, S);
end;

{ saati ayarlad?m. sistem saatine göre ayarl?yorum}
procedure Tsaat.SetClkTime( CTime : TDateTime);
begin
  ZamanFarki( CTime, Time, CsaatFarki, CdakikaFarki);
  invalidate;
end;

function Tsaat.MinuteAngle( Min : word) : real;
begin
  MinuteAngle := Min * 2 * Pi / 60;
end; { MinuteAngle}

function Tsaat.HourAngle( Hou, Min : word) : real;
begin
HourAngle := ( Hou MOD 12) * 2 * Pi / 12 + MinuteAngle( Min) / 12;
end; { saat aç?s?}

procedure Tsaat.TickerCall(Sender: TObject);
var
  H, M, S, pH, pM, pS : word;
begin
  if csDesigning in ComponentState then exit;

  DecodeCTime( Time, H, M, S);
  DecodeCTime( PrevTime, pH, pM, pS);


  if Assigned( Fsaniye) then Fsaniye( Self); { saniye}
  if Assigned( Fdakika) AND ( pS > S) then Fdakika( Self); { dakika}
  if Assigned( Fsaat) AND ( pM > M) then Fsaat( Self); { saat}
  PrevTime := Time;

  { eger saniye iptal edilirse saniye okunu gostermeyecek}
  if ( NOT saniyeyiGoster) AND ( pS <= S) then exit;

  { sonra saatin oklarini cizecegiz}
  DrawArrows; {}
end;

procedure Tsaat.DrawArrows;
var
  H, M, S : word;
  CurPoint : TPoint;
  CTime : TDateTime;
  ABitMap : TBitMap;

  procedure DrawArrow( Angle, Scale : real; AWidth : integer);
  var SR : real;
  begin
    with ABitMap.Canvas do begin
      Pen.Width := AWidth;
      MoveTo( CenterPoint.X, CenterPoint.Y);
      SR := Scale *  Radius;
      LineTo( trunc(  SR * sin( Angle)) + CenterPoint.X,
              trunc( -SR * cos( Angle)) + CenterPoint.Y);
      end;
  end;

begin
  { yeni bir bitmap yaptik}
  ABitMap := TBitMap.Create;
  FPen.Color := ClkArrowColor;

  try { yeni resimde oklari cizdik}
    { yeni resmin ozelliklerini ayarladik}
    ABitMap.Width := Width;
    ABitMap.Height := Height;
    with ABitMap.Canvas do begin
      Pen := FPen;
      Brush.Color := ClkFaceColor;
      end;
    { yeni resmi bitmapdan kopyaladik aldik..}
    ABitMap.Canvas.CopyMode := cmSrcCopy;
    ABitMap.Canvas.CopyRect(
        ABitMap.Canvas.ClipRect,
        FBitMap.Canvas,
        FBitMap.Canvas.ClipRect
        );
    { yeni oklari cizdik}
    DecodeCTime( Time, H, M, S);
    if saniyeyiGoster then
      DrawArrow( MinuteAngle( S),  SecScale, SecThick); { saniye}
    DrawArrow( MinuteAngle( M),  MinScale, MinThick);   { dakika}
    DrawArrow( HourAngle( H, M), HouScale, HouThick);   { saat}

    Canvas.CopyMode := cmSrcCopy;
    Canvas.Draw( 0, 0, ABitMap);
  finally
    ABitMap.Free;
    end;
end;

procedure Tsaat.saatAyarlari;
begin
  {yeni bir arka plan resmi olusturduk}
  FBitMap.Free;
  FBitMap := TBitMap.Create;
  FBitMap.Width := Width;
  FBitMap.Height := Height;
  { saatin oklarinin merkezini ayarladim}
  CenterPoint := Point( Width DIV 2, Height DIV 2 );
  { yaricaplarini hesapladim}
  with CenterPoint do
    if X <= Y then Radius := X
    else           Radius := Y;

  LapStepW := Radius DIV 8;
  if LapStepW < 6 then LapStepW := 6;

  dec( Radius, LapStepW + 2);
end; { saatAyarlari sonu}

{saatin arkaplanini cizdik}
procedure Tsaat.DrawClockBkg;

  procedure Draw3dRect( ARect : TRect);
  begin
    Frame3D( FBitMap.Canvas, ARect, clBtnHighlight, clBtnShadow, 1);
  end;

  { dakikanin gececegi noktalari olusturdum}
  procedure DrawMinSteps;
  var
    CPen1, CPen2 : TPen;
    OfsX, OfsY : integer;
    MinCou : word;
    CurPt : TPoint;
    TmpRect : TRect;
    SR, Ang : real;
  begin
    OfsX := LapStepW DIV 2; OfsY := OfsX;
    MinCou := 0;
    while MinCou < 56 do begin
      SR := Radius + OfsX;
      Ang := MinuteAngle( MinCou);
      CurPt := Point(
                 trunc(  SR * sin( Ang)) + CenterPoint.X,
                 trunc( -SR * cos( Ang)) + CenterPoint.Y);
      if MinCou MOD 15 = 0 then
        TmpRect := Rect( CurPt.X - OfsX, CurPt.Y - OfsY,
                         CurPt.X + OfsX, CurPt.Y + OfsY)
      else
        TmpRect := Rect( CurPt.X - 2, CurPt.Y - 2,
                         CurPt.X + 2, CurPt.Y + 2);

      Draw3dRect( TmpRect);

      inc( MinCou, 5);
      end; { while MinCou < 56}
  end; { DrawMinSteps}

begin
  with FBitMap.Canvas do begin
    Brush.Style := bsSolid;
    Brush.Color := ClkFaceColor;
    FillRect( ClipRect);
    end;
  DrawMinSteps;
end; { DrawClockBkg}

end.