Analog Saat Komponenti

'Programlama' forumunda ...... tarafından 6 Ağu 2009 tarihinde açılan konu

Konu etiketleri:
  1. ......

    ...... Misafir

    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.
     

Bu Sayfayı Paylaş