Ana Sayfa > Kodlar > Delphi ile Basit analog saat yapmak

Delphi ile Basit analog saat yapmak


Delphi 6 ile haırlanmış Analog Saat Örnegidir. Tray için geliştirildi.

Form Üzerine
1 Adet Timer Bileşeni
1 Adet Shape Bileşeni (Şeklini Circle Seçin)
5 Adet Label Bileşeni (12,3,6 ve 9 yerine koyun)
Bir Adet popu menü bileşeni

unit Saat;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, Menus, shellapi;

type
TForm1 = class(TForm)
Timer1: TTimer;
Shape1: TShape;
Image1: TImage;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
PopupMenu1: TPopupMenu;
Kapat1: TMenuItem;
Label5: TLabel;
raydaBekle1: TMenuItem;
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1DblClick(Sender: TObject);
procedure Kapat1Click(Sender: TObject);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure raydaBekle1Click(Sender: TObject);
procedure Image1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
stray:NOTIFYICONDATA;
implementation

{$R *.dfm}

function modulal(x:Integer):Integer;
begin
while x < 0 do
begin
x := x + 360;
end;
Result := x;
end;

function kactane(x:Integer; y: Integer):Integer;
var
times: Integer;
begin
times := 0;
while x >= y  do
begin
x := x - y;
times := times + 1;
end;
Result := times;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
sn: Integer;
dk: Integer;
st: Integer;
x: String;
y: String;
z: String;
dg: Extended;
dg2: Extended;
dg3: Extended;
linex: Integer;
liney: Integer;
linex2: Integer;
liney2: Integer;
linex3: Integer;
liney3: Integer;
begin
x := TimeToStr(Time);
y := TimeToStr(Time);
z := TimeToStr(Time);
Delete(x, 1,6);
Delete(y, 1, 3);
Delete(y, 3, 3);
Delete(z, 3,6);
sn := StrToInt(x);
dk := StrToInt(y);
st := StrToInt(z);
dg := ((modulal((90 - (sn * 6))) * pi ) / 180);
dg2 := ((modulal((90 - (dk * 6))) * pi ) / 180);
dg3 := ((modulal((90 - (st * 30) - (kactane(dk, 6)*3)   )) * pi ) / 180);
linex := 110 + Round(90 * cos(dg));
liney := 110 - Round(90 * sin(dg));
linex2 := 110 + Round(90 * cos(dg2));
liney2 := 110 - Round(90 * sin(dg2));
linex3 := 110 + Round(55 * cos(dg3));
liney3 := 110 - Round(55 * sin(dg3));

Form1.Refresh;
with Form1.Canvas do
begin

Pen.Width := 1;
MoveTo(110,110);
Pen.Color := clRed;
LineTo(linex, liney);
MoveTo(110,110);
Pen.Width := 2;
Pen.Color := clblue;
LineTo(linex2, liney2);
MoveTo(110,110);
Pen.Width := 3;
LineTo(linex3, liney3);
end;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
with stray do
begin
cbsize:=sizeof(stray);
wnd:=form1.handle;
hicon:=Application.icon.Handle;
uID:=0;
sztip:=Program Tray Üzerinde;
uflags:=7;
uCallBackMessage:=$200;//icon üzerine tıklama kontrolu için
end;
Shell_NotifyIcon(0,@stray);
Brush.Style:=bsClear;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
begin
ReleaseCapture;
SendMessage(Handle,WM_SYSCOMMAND,SC_MOVE+1,0);
end;
end;

procedure TForm1.Image1DblClick(Sender: TObject);
begin
close;
end;

procedure TForm1.Kapat1Click(Sender: TObject);
begin
close;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);

var nokta:TPoint;
begin
getCursorPos(nokta);
if (x=$205) then PopupMenu1.Popup(nokta.x,nokta.y);
end;

procedure TForm1.raydaBekle1Click(Sender: TObject);
begin
if form1.Visible=false then
form1.Visible:=true
else
form1.Visible:=false;
end;

end.


TD Software


About these ads
  1. Henüz yorum yapılmamış.
  1. No trackbacks yet.

Bir Cevap Yazın

Aşağıya bilgilerinizi girin veya oturum açmak için bir simgeye tıklayın:

WordPress.com Logosu

WordPress.com hesabınızı kullanarak yorum yapıyorsunuz. Log Out / Değiştir )

Twitter picture

Twitter hesabınızı kullanarak yorum yapıyorsunuz. Log Out / Değiştir )

Facebook fotoğrafı

Facebook hesabınızı kullanarak yorum yapıyorsunuz. Log Out / Değiştir )

Google+ fotoğrafı

Google+ hesabınızı kullanarak yorum yapıyorsunuz. Log Out / Değiştir )

Connecting to %s

Takip Et

Her yeni yazı için posta kutunuza gönderim alın.

Diğer 901 takipçiye katılın

%d blogcu bunu beğendi: