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.