Arama butonu
Bu konudaki kullanıcılar: 1 misafir, 1 mobil kullanıcı
2
Cevap
399
Tıklama
0
Öne Çıkarma
KOD ARŞİVİ
R
20 yıl
Er
Konu Sahibi

GÜZEL KOD ARŞİVİ YAPALIM HEP BİRLİKTE İLK AÇILIŞ BENDEN
AMA HER DİLDEN KOD EKLEYEBİLİRİZ EKLEDİĞİMİZ KODLARIN HANGİ DİLE AİT OLDUĞUNU YADA HANGİ PROGRAMDA KULLANILDIĞINI YAZALIM LÜTFEN



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.


aslında bu saat güzel istediğiniz başka bi program varsa sadece delphi değil yardım etmek isterim



B
20 yıl
Yüzbaşı

Gerçekten güzel bir uygulama inşaallah devam eder. Elime geçen kodlar olursa koyacağım.


Bu mesaja 1 cevap geldi.
K
20 yıl
Yüzbaşı

bu topiğin yeri yazılım geliştirme bölümü....burda beklediğin ilgiyi bulamazsın...



DH Mobil uygulaması ile devam edin. Mobil tarayıcınız ile mümkün olanların yanı sıra, birçok yeni ve faydalı özelliğe erişin. Gizle ve güncelleme çıkana kadar tekrar gösterme.