arkadaşlar şöyle bir saat componente yapmaya çalıştım ama

FXERKAN · Mesaj gönderen **FXERKAN** » 03 Nis 2004 09:32

arkadaşlar şöyle bir saat componente yapmaya çalıştım ama bir sorun var. hiçbirşey görünmüyor ve eğer formunuza koyarsanız gördüğünüz gibi component sürekli çalışıyor, resmi çizemiyor acaba sorun nerede

kod aşağıda baya uzun ama denerseniz çok sevinirim

--------------------------------------------------------------------

Kod: Tümünü seç

unit FXSaat;

interface

uses
  Controls, Messages, Classes, SysUtils, ExtCtrls, Windows,Graphics, Forms;

type
  TfxSaatTipi = (stDijital ,stAnalog);
  TfxGoruntuTipi = (gtNoktalar, gtRakamlar, gtRomaRakamlari);

  TFXSaat = class;

  TFXKolOzellikleri = class(TPersistent)
  private
    FSaatRengi: TColor;
    FSaatUzunlugu: Integer;
    FSaatKalinligi: Integer;
    FDakikaRengi: TColor;
    FDakikaKalinligi: Integer;
    FDakikaUzunlugu: Integer;
    FSaniyeRengi: TColor;
    FSaniyeUzunlugu: Integer;
    FSaniyeKalinligi: Integer;
    FSaniyeGoster: Boolean;
    FSaat: TFXSaat;
    procedure SetSaatRengi(Value: TColor);
    procedure SetSaatUzunlugu(Value: Integer);
    procedure SetSaatKalinligi(Value: Integer);
    procedure SetDakikaRengi(Value: TColor);
    procedure SetDakikaUzunlugu(Value: Integer);
    procedure SetDakikaKalinligi(Value: Integer);
    procedure SetSaniyeRengi(Value: TColor);
    procedure SetSaniyeUzunlugu(Value: Integer);
    procedure SetSaniyeKalinligi(Value: Integer);
    procedure SetSaniyeGoster(Value: Boolean);
    procedure SetSaat(Value: TFXSaat);
  protected
    constructor Create;
  published
    property SaatRengi: TColor read FSaatRengi write SetSaatRengi;
    property SaatUzunlugu: Integer read FSaatUzunlugu write SetSaatUzunlugu;
    property SaatKalinligi: Integer read FSaatKalinligi write SetSaatKalinligi;
    property DakikaRengi: TColor read FDakikaRengi write SetDakikaRengi;
    property DakikaUzunlugu: Integer read FDakikaUzunlugu write SetDakikaUzunlugu;
    property DakikaKalinligi: Integer read FDakikaKalinligi write SetDakikaKalinligi;
    property SaniyeRengi: TColor read FSaniyeRengi write SetSaniyeRengi;
    property SaniyeUzunlugu: Integer read FSaniyeUzunlugu write SetSaniyeUzunlugu;
    property SaniyeKalinligi: Integer read FSaniyeKalinligi write SetSaniyeKalinligi;
    property SaniyeGoster: Boolean read FSaniyeGoster write SetSaniyeGoster;
    property Saat: TFXSaat read FSaat write SetSaat;
  end;





  TOnTimeChange = procedure(Sender: TFXSaat; OldTime , NewTime: TDateTime) of object;
  TFXSaat = class(TImage)
  private
    FTime: TDateTime;
    FTimer: TTimer;
    FGoruntuFormat: String;
    FSaatTipi: TFXSaatTipi;
    FKolOzellikleri: TFXKolOzellikleri;
    FNoktalar: Boolean;
    FSaatResmi: TBitmap;
    FGoruntuTipi: TFXGoruntuTipi;
    FActive: Boolean;
    FOnHourChange: TOnTimeChange;
    FOnMinuteChange: TOnTimeChange;
    FOnSecondChange: TOnTimeChange;
    FOldText: String;
    FCount: Integer;
    function GetTime: TDateTime;
    procedure TimeChange(Sender: TObject);
    procedure SetGoruntuFormat(Value: String);
    procedure SetSaatTipi(Value: TFXSaatTipi);
//    function  GetColor(BColor, EColor: TColor; N, H: Integer): TColor;
    procedure WMEraseBkGnd(var Msg: TMessage); message WM_ERASEBKGND;
    procedure SetKolOzellikleri(Value: TFXKolOzellikleri);
    procedure SetNoktalar(Value: Boolean);
    procedure SetSaatResmi(Value: TBitmap);
    procedure SetGoruntuTipi(Value: TFXGoruntuTipi);
    procedure SetActive(Value: Boolean);
    procedure UpdateClock;
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Time: TDateTime read FTime;
  published
    property GoruntuFormat: String read FGoruntuFormat write SetGoruntuFormat;
    property SaatTipi: TFXSaatTipi read FSaatTipi write SetSaatTipi;
    property KolOzellikleri: TFXKolOzellikleri read FKolOzellikleri write SetKolOzellikleri;
    property Noktalar: Boolean read FNoktalar write SetNoktalar default false;
    property SaatResmi: TBitmap read FSaatResmi write SetSaatResmi;
    property GoruntuTipi: TFXGoruntuTipi read FGoruntuTipi write SetGoruntuTipi;
    property Active: Boolean read FActive write SetActive default False;
    property OnHourChange: TOnTimeChange read FOnHourChange write FOnHourChange;
    property OnMinuteChange: TOnTimeChange read FOnMinuteChange write FOnMinuteChange;
    property OnSecondChange: TOnTimeChange read FOnSecondChange write FOnSecondChange;
  end;

var
DrawBmp: TBitmap;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('FX', [TFXSaat]);
end;


//******************************************************************************
//                              KOL ÖZELLİKLERİ
//******************************************************************************
constructor TFXKolOzellikleri.Create;
begin
  inherited;
  FSaatRengi := clNavy;
  FSaatUzunlugu := 60;
  FSaatKalinligi := 5;
  FDakikaRengi := clBlue;
  FDakikaUzunlugu := 80;
  FDakikaKalinligi := 3;
  FSaniyeRengi := clRed;
  FSaniyeUzunlugu := 90;
  FSaniyeKalinligi := 1;
  FSaniyeGoster := True;
end;

//YELKOVAN----------------------------------------------------------------------
procedure TFXKolOzellikleri.SetSaatRengi(Value : TColor);
begin
 FSaatRengi := Value;
 if not FSaat.Active then FSaat.UpdateClock;
end;

procedure TFXKolOzellikleri.SetSaatUzunlugu(Value : integer);
begin
  FSaatUzunlugu := Value;
  if Value < 0 then FSaatUzunlugu := 0;
  if Value > 100 then FSaatUzunlugu := 100;
  if not FSaat.Active then FSaat.UpdateClock;
end;

procedure TFXKolOzellikleri.SetSaatKalinligi(Value:integer);
begin
  FSaatKalinligi := Value;
  if Value < 0 then FSaatKalinligi := 0;
  if not FSaat.Active then FSaat.UpdateClock;
end;
//------------------------------------------------------------------------------

//AKREP-------------------------------------------------------------------------
procedure TFXKolOzellikleri.SetDakikaRengi(Value : TColor);
begin
 FDakikaRengi := Value;
 if not FSaat.Active then FSaat.UpdateClock;
end;

procedure TFXKolOzellikleri.SetDakikaUzunlugu(Value: Integer);
begin
  FDakikaUzunlugu := Value;
  if Value < 0 then FDakikaUzunlugu := 0;
  if Value > 100 then FDakikaUzunlugu := 100;
  if not FSaat.Active then FSaat.UpdateClock;
end;

procedure TFXKolOzellikleri.SetDakikaKalinligi(Value: Integer);
begin
  FDakikaKalinligi := Value;
  if Value < 0 then FDakikaKalinligi := 0;
  if not FSaat.Active then FSaat.UpdateClock;
end;
//------------------------------------------------------------------------------

//SANİYE------------------------------------------------------------------------
procedure TFXKolOzellikleri.SetSaniyeRengi(Value:TColor);
begin
 FSaniyeRengi := Value;
 if not FSaat.Active then FSaat.UpdateClock;
end;

procedure TFXKolOzellikleri.SetSaniyeUzunlugu(Value: Integer);
begin
  FSaniyeUzunlugu := Value;
  if Value < 0 then FSaniyeUzunlugu := 0;
  if Value > 100 then FSaniyeUzunlugu := 100;
  if not FSaat.Active then FSaat.UpdateClock;
end;

procedure TFXKolOzellikleri.SetSaniyeKalinligi(Value: Integer);
begin
  FSaniyeKalinligi := Value;
  if Value < 0 then FSaniyeKalinligi := 0;
  if not FSaat.Active then FSaat.UpdateClock;
end;

procedure TFXKolOzellikleri.SetSaniyeGoster(Value: Boolean);
begin
  FSaniyeGoster := Value;
  if not FSaat.Active then FSaat.UpdateClock;
end;
//------------------------------------------------------------------------------



procedure TFXKolOzellikleri.SetSaat(Value: TFXSaat);
begin
  FSaat := Value;
end;



//******************************************************************************
//                                      TFXSAAT
//******************************************************************************
constructor TFXSaat.Create(AOwner: TComponent);
begin
  inherited;
  FTime := GetTime;
  Width := 65;
  Height := 19;
  FTimer := TTimer.Create(Self);
  FTimer.Interval := 250;
  FTimer.OnTimer := TimeChange;
  FTimer.Enabled := False;
  FGoruntuFormat := 'hh:mm:ss';
  FKolOzellikleri := TFXKolOzellikleri.Create;
  FKolOzellikleri.Saat := self;
  FNoktalar := True;
  FSaatResmi := TBitmap.Create;
  FGoruntuTipi := gtNoktalar;
  FActive := False;
  FOldText := '';
end;

destructor TFXSaat.Destroy;
begin
  FTimer.Free;
  FKolOzellikleri.Free;
  FSaatResmi.Free;
  inherited;
end;

function TFXSaat.GetTime: TDateTime;
var
  Seconds: Integer;
  MSecs: Comp;
  ADate: TTimeStamp;
begin
  if FActive then
  begin
    ADate := DateTimeToTimeStamp(Now);
    //Seconds := FOffsetHour * 3600 + FOffsetMin * 60 + FOffsetSec;
    Seconds := 0 * 3600 + 0 * 60 + 0;
    if Seconds <> 0 then
    begin
      MSecs := TimeStampToMSecs(ADate);
      MSecs := MSecs + Seconds * 1000;
      ADate := MSecsToTimeStamp(MSecs);
    end;
    Result := TimeStampToDateTime(ADate);
  end
  else
    Result := 0;
end;

procedure TFXSaat.TimeChange(Sender: TObject);
var ATime: TDateTime;
    Hour1, Min1, Sec1, MSec1: Word;
    Hour2, Min2, Sec2, MSec2: Word;
begin
  ATime := FTime;
  FTime := GetTime;
  DecodeTime(ATime, Hour1, Min1, Sec1, MSec1);
  DecodeTime(FTime, Hour2, Min2, Sec2, MSec2);
  if (Sec1 <> Sec2) or (Min1 <> Min2) or (Hour1 <> Hour2) then UpdateClock;
  if Assigned(FOnHourChange) and (Hour1 <> Hour2) then FOnHourChange(Self, ATime, FTime);
  if Assigned(FOnMinuteChange) and (Min1 <> Min2) then FOnMinuteChange(Self, ATime, FTime);
  if Assigned(FOnSecondChange) and (Sec1 <> Sec2) then FOnSecondChange(Self, ATime, FTime);
end;

procedure TFXSaat.SetActive(Value: Boolean);
begin
  FActive := Value;
  FTimer.Enabled := FActive;
  FTime := GetTime;
  UpdateClock;
end;

procedure TFXSaat.SetGoruntuFormat(Value: String);
begin
  if Value <> FGoruntuFormat then FGoruntuFormat := Value;
  if not FActive then UpdateClock;
end;

procedure TFXSaat.SetSaatTipi(Value: TFXSaatTipi);
begin
  if Value <> FSaatTipi then FSaatTipi := Value;
  if not FActive then UpdateClock;
end;

procedure TFXSaat.SetKolOzellikleri(Value: TFXKolOzellikleri);
begin
  FKolOzellikleri.Assign(Value);
end;

procedure TFXSaat.SetNoktalar(Value: Boolean);
begin
  FNoktalar := Value;
  if not FActive then UpdateClock;
end;


procedure TFXSaat.SetSaatResmi(Value: TBitmap);
begin
  FSaatResmi.Assign(Value);
  if not FActive then UpdateClock;
end;


procedure TFXSaat.SetGoruntuTipi(Value: TFXGoruntuTipi);
begin
  FGoruntuTipi := Value;
  if not FActive then UpdateClock;
end;

procedure TFXSaat.Paint;
const
  Decimal: array[0..11] of String = ('6', '5', '4', '3', '2', '1', '12', '11', '10', '9', '8', '7');
  Roman: array[0..11] of String = ('VI', 'V', 'IV', 'III', 'II', 'I', 'XII', 'XI', 'X', 'IX', 'VIII', 'VII');
var
  R, Rect: TRect;
  TopColor, BottomColor: TColor;
  a, W, H, dX, dY, d, cX, cY, X, Y, X1, Y1, i, Radius, dd: Integer;
  S: String;
  Hour, Min, Sec, MSec: Word;

{
  procedure AdjustColors(Bevel: TPanelBevel);
  begin
    TopColor := GetColor(clWhite, FBorderColor, 1, 4);
    if Bevel = bvLowered then TopColor := GetColor(clBlack, FBorderColor, 2, 3);
    BottomColor := GetColor(clBlack, FBorderColor, 2, 3);
    if Bevel = bvLowered then BottomColor := GetColor(clWhite, FBorderColor, 1, 4);
  end;
}

begin

  if DrawBmp.Width  < Width  then DrawBmp.Width  := Width;
  if DrawBmp.Height < Height then DrawBmp.height := height;


  Rect := GetClientRect;
  R := Rect;

//  DrawBmp.Canvas.Brush.Color := FBorderColor;
  DrawBmp.Canvas.FillRect(R);
  inflateRect(R, -d, -d);
  DrawBmp.Canvas.Brush.Color := Color;
  DrawBmp.Canvas.FillRect(R);

  if not FSaatResmi.Empty then begin
    R := ClientRect;
    inflateRect(R, -d, -d);
    SetStretchBltMode(DrawBmp.Canvas.Handle, COLORONCOLOR);
    StretchBlt(DrawBmp.Canvas.Handle, R.Left, R.Top, R.Right - R.LEft, R.Bottom - R.Top,
               FSaatResmi.Canvas.Handle, 0, 0, FSaatResmi.Width, FSaatResmi.Height, SRCCOPY);
  end;


  DecodeTime(FTime, Hour, Min, Sec, MSec);

  if FSaatTipi = stAnalog then with DrawBmp.Canvas do begin
    cX := Width div 2;
    cY := Height div 2;
    if cX < cY then Radius := cX else Radius := cY;


    if FGoruntuTipi <> gtNoktalar then begin
       DrawBmp.Canvas.Font := Self.Font;
       H := DrawBmp.Canvas.TextHeight('Wg') div 2;
       if FGoruntuTipi = gtRomaRakamlari then W := DrawBmp.Canvas.TextWidth('VIII') div 2
       else W := DrawBmp.Canvas.TextWidth('12') div 2;
       dec(Radius, Trunc(SQRT(H*H + W*W)) + 4);
    end
    else  dec(Radius, d + 10);

    if FNoktalar then
      if Radius > 70 then
        for i := 0 to 59 do begin
          a := 6 * i;
          X := cX + Round(Radius * Sin(a * PI / 180));
          Y := cY + Round(Radius * Cos(a * PI / 180));
          if (i mod 5) <> 0 then begin
            dd := Radius div 70;
            dec(dd);
            if dd <= 0 then dd := 1;
            Brush.Color := clWhite;
            Pen.Color := clWhite;
            Rectangle(X - dd -1, Y - dd -1, X + dd -1, Y +dd -1);
            Brush.Color := clGray;
            Pen.Color := clGray;
            Rectangle(X - dd +1 , Y - dd + 1 , X + dd + 1 , Y + dd +1);
            Brush.Color := clSilver;
            Pen.Color := clSilver;
            Rectangle(X - dd, Y - dd, X + dd, Y + dd);
          end;
        end;

    if FNoktalar then
      for i := 0 to 11 do begin
        a := 30 * i;
        X := cX + Round(Radius * Sin(a * PI / 180));
        Y := cY + Round(Radius * Cos(a * PI / 180));
        if FGoruntuTipi = gtNoktalar then begin
          dd := Radius div 70;
          if dd <= 0 then dd := 1;
          Brush.Color := clAqua;
          Pen.Color := clAqua;
          Rectangle(X - dd -1, Y - dd -1, X + dd -1, Y +dd -1);
          Brush.Color := clNavy;
          Pen.Color := clNavy;
          Rectangle(X - dd +1 , Y - dd + 1 , X + dd + 1 , Y + dd +1);
          Brush.Color := clBlue;
          Pen.Color := clBlue;
          Rectangle(X - dd, Y - dd, X + dd, Y + dd);
        end else begin
          if FGoruntuTipi = gtRomaRakamlari then S := Decimal[i];
          if FGoruntuTipi = gtRomaRakamlari then S := Roman[i];
          H := TextHeight(S) div 2;
          W := TextWidth(S) div 2;
          Brush.Style := bsClear;
          TextOut(X - W, Y - H, S);
          Brush.Style := bsSolid;
        end;
      end;


    if FKolOzellikleri.SaatUzunlugu > 0 then begin
      d := Trunc(Radius * FKolOzellikleri.SaatUzunlugu / 100);
      X := cX + Round(d * Sin((180 - (Hour mod 12 + Min/60) * 30) *PI / 180));
      Y := cY + Round(d * Cos((180 - (Hour mod 12 + Min/60) * 30) *PI / 180));
      X1 := cX + Round(d/7 * Sin((360 - (Hour mod 12 + Min/60) * 30) *PI / 180));
      Y1 := cY + Round(d/7 * Cos((360 - (Hour mod 12 + Min/60) * 30) *PI / 180));
      Pen.Color := FKolOzellikleri.SaatRengi;
      Pen.Width := FKolOzellikleri.SaatKalinligi;
      MoveTo(X1, Y1);
      LineTo(X, Y);
      Pen.Width := 1;
    end;

    if FKolOzellikleri.DakikaUzunlugu > 0 then begin
      d := Trunc(Radius * FKolOzellikleri.DakikaUzunlugu / 100);
      X := cX + Round(d * Sin((180 - (Min + Sec/60) * 6) *PI / 180));
      Y := cY + Round(d * Cos((180 - (Min + Sec/60) * 6) *PI / 180));
      X1 := cX + Round(d/7 * Sin((360 - (Min + Sec/60) * 6) *PI / 180));
      Y1 := cY + Round(d/7 * Cos((360 - (Min + Sec/60) * 6) *PI / 180));
      Pen.Color := FKolOzellikleri.DakikaRengi;
      Pen.Width := FKolOzellikleri.DakikaKalinligi;
      MoveTo(X1, Y1);
      LineTo(X, Y);
      Pen.Width := 1;
    end;

    if FKolOzellikleri.SaniyeGoster  and (FKolOzellikleri.SaniyeUzunlugu > 0) then begin
      d := Trunc(Radius * FKolOzellikleri.SaniyeUzunlugu / 100);
      X := cX + Round(d * Sin((180 - Sec * 6) *PI / 180));
      Y := cY + Round(d * Cos((180 - Sec * 6) *PI / 180));
      X1 := cX + Round(d/7 * Sin((360 - Sec * 6) *PI / 180));
      Y1 := cY + Round(d/7 * Cos((360 - Sec * 6) *PI / 180));
      Pen.Width := FKolOzellikleri.SaniyeKalinligi;
      Pen.Color := FKolOzellikleri.SaniyeRengi;
      MoveTo(X1, Y1);
      LineTo(X, Y);
      Pen.Width := 1;
    end;

    Pen.Width := 1;
    Pen.Color := clBlack;
    Brush.Color := FKolOzellikleri.SaniyeRengi;
    d := Radius div 20;
    Ellipse(cX - d, cY - d, cX + d, cY + d);
  end
  else
  begin
    Rect := GetClientRect;
    with DrawBmp.Canvas do begin
      Font := Self.Font;
      S := FormatDateTime(FGoruntuFormat, FTime);
      if FSaatTipi = stDijital then
      begin
        H := TextHeight(S);
        W := TextWidth(S);
        dX := (Width - W) div 2;
        dY := (Height - H) div 2;
        Brush.Style := bsClear;
        TextRect(R, dX, dY, S);
        Brush.Style := bsSolid;
      end;

    end;
  end;

  Canvas.Draw(0, 0, DrawBmp);
end;



{
function TFXSaat.GetColor(BColor, EColor: TColor; N, H: Integer): TColor;
begin
  Result := RGB(Trunc(GetRValue(BColor) + (GetRValue(EColor)-GetRValue(BColor)) * N / H),
                  Trunc(GetGValue(BColor) + (GetGValue(EColor)-GetGValue(BColor)) * N / H),
                  Trunc(GetBValue(BColor) + (GetBValue(EColor)-GetBValue(BColor)) * N / H));
end;
}


procedure TFXSaat.WMEraseBkGnd(var Msg: TMessage);
begin
  Msg.Result := 1;
end;

procedure TFXSaat.UpdateClock;
var i: Integer;
begin

    if (FOldText <> '') and (FOldText <> SysUtils.FormatDateTime(FGoruntuFormat, FTime)) then
      for i := 1 to 10 do begin
        FCount := i;
        Repaint;
      end
    else begin
      FCount := 10;
      Repaint;
    end;
    FOldText := SysUtils.FormatDateTime(FGoruntuFormat, FTime);

end;

//******************************************************************************



initialization
  DrawBmp := TBitmap.Create;

finalization
  DrawBmp.Free;


end.

Mesaj gönderen **freeman35** » 03 Nis 2004 09:56

sana forum kurallarını oku, kod yazacağın zaman yukarıdaki "Code" yazan butonu kullan dersek ayıp olacak ama diyeceğim genede.

DrawBmp bunun Parent ı ne ?? parent ı olmazsa yanılmıyorsam bu bişi çizmez. Component ı TCustomPanel den türetirsen onun bevel gibi bazı visual property lerinide çıkartırsan bence daha güzel olur. Ayrıca yanılmıyorsam TCustomPanel'den türetirsen, direk onun canvas ını kullanabiirsin. Birde Timer sız yapmayı araştır. windows saatine hook atmaya yada benzeri bir şey kullan, şimdi aklıma geldi. ama tam ne olduğunu hatırlamıyorum. Hatırladığım, Windows zaman değiştiğinde bir message atıyordu yada benzer bir tetikleme yapıyordu sanırım. bunu kullanırsan daha randımanlı olur. Çünki TTimer pek sağlıklı bir nesne değil. sürekli kullanılacaksa pek sıcak bakılmıyordu eskiden.

Kolay gele

Mesaj gönderen **husonet** » 04 Nis 2004 11:53

Merhaba

Algoritması çok basit bir bileşen

Kod: Tümünü seç

unit HUSOANALOG;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
wintypes,extctrls,math;
type
  THusoAnalogSaat = class(TGraphicControl)
  private
    { Private declarations }
  protected
    { Protected declarations }
  public
    saat,dakika,saniye,salise:word;
    sx,sy,x,y:real;
    mrect:Trect;
  constructor create(AOwner:Tcomponent);override;
  destructor Destroy; override;
    { Public declarations }
  published
  zamanlayici:Ttimer;
  procedure saaticiz;
  procedure calis(Sender:Tobject);
    { Published declarations }
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Huso Component Set', [THusoAnalogSaat]);
end;

{ THusoAnalogSaat }

procedure THusoAnalogSaat.calis(Sender: Tobject);
begin
    saaticiz;
    //saniyenin hareketi ve çizimi
    canvas.brush.Color:=clRed;
    canvas.TextOut(60,85,'HUSOSET');
    Canvas.TextOut(70,100,'Ver:1.0');
    decodetime(time,saat,dakika,saniye,salise);
    canvas.pen.Width:=2;
    x:=80+60*sin(saniye*pi/30);
    y:=80-60*cos(saniye*pi/30);
    canvas.MoveTo(round(x),round(y));
    canvas.Pen.Color:=clRed;
    canvas.LineTo(80,80);
    //dakikanın çizimi ve hareketi
    x:=80+60*sin(6*(dakika+saniye/60)*2*pi/360);
    y:=80-60*cos(6*(dakika+saniye/60)*2*pi/360);
    canvas.MoveTo(round(x),round(y));
    canvas.pen.Color:=clblack;
    canvas.LineTo(80,80);
    //Saat kolunun çizimi ve harketi
    canvas.pen.width:=4;
    x:=80+40*sin(((saat mod 12)+(dakika/60))*pi/6);
    y:=80-40*cos(((saat mod 12)+(dakika/60))*pi/6);
    canvas.MoveTo(round(x),round(y));
    canvas.LineTo(80,80);
    canvas.pen.width:=1;
end;

constructor THusoAnalogSaat.create(AOwner: Tcomponent);
begin
  inherited;
    height:=161;
    width:=161;
    zamanlayici:=Ttimer.create(self);
    zamanlayici.Interval:=1000;
    zamanlayici.ontimer:=calis;
    zamanlayici.enabled:=true;

end;

destructor THusoAnalogSaat.Destroy;
begin
  inherited;

end;

procedure THusoAnalogSaat.saaticiz;
var
    i:integer;
begin
    //Saatin genel çizimi
    mrect:=rect(0,0,161,161);
    canvas.Pen.Color:=clblack;
    canvas.Brush.Color:=clYellow;
    canvas.Ellipse(mrect);
    //Rakamların yerleşimi
    canvas.TextOut(73,4,'XII');
    canvas.TextOut(74,145,'VI');
    canvas.TextOut(5,73,'IX');
    canvas.TextOut(147,73,'III');
    canvas.TextOut(38,11,'XI');
    canvas.TextOut(117,13,'I');
    canvas.TextOut(15,38,'X');
    canvas.TextOut(140,39,'II');
    canvas.TextOut(136,111,'IV');
    canvas.TextOut(14,111,'VIII');
    canvas.TextOut(112,135,'V');
    canvas.TextOut(37,134,'VII');
    //Saat çizgileri belirleniyor
    for i:=0 to 59 do
        if i mod 5=0 then
        begin
            sx:=80-80*cos(i/5*pi/6);
            sy:=80-80*sin(i/5*pi/6);
            canvas.MoveTo(round(sx),round(sy));
            sx:=80-77*cos(i/5*pi/6);
            sy:=80-77*sin(i/5*pi/6);
            canvas.pen.Width:=2;
            canvas.LineTo(round(sx),round(sy));
        end
        else
        begin
            sx:=80-80*cos(i*pi/30);
            sy:=80-80*sin(i*pi/30);
            canvas.MoveTo(round(sx),round(sy));
            sx:=80-79*cos(i*pi/30);
            sy:=80-79*sin(i*pi/30);
            canvas.LineTo(round(sx),round(sy));
        end;
end;

end.

Kolay Gelsin...