Bydigi Forum
Geri Git   Bydigi Forum > Webmaster Blm ve Programlama Dilleri > Programlama Dilleri > Pascal - Delphi

Kayt Ol SSS



 

 

LinkBack (1) Konu Aralar
Eski 08-12-2006, 02:11 PM   1 links from elsewhere to this Post. Click to view. #1 (permalink)
 
Giri Tarihi: Jul 2006
Konum: Amed
Mesaj: 2,992
ye No: 16335
Cinsiyeti : Bay
tibar Gc: 39085
Rep Puan : 3908079
Rep Derecesi
bereday21 has a reputation beyond reputebereday21 has a reputation beyond reputebereday21 has a reputation beyond reputebereday21 has a reputation beyond reputebereday21 has a reputation beyond reputebereday21 has a reputation beyond reputebereday21 has a reputation beyond reputebereday21 has a reputation beyond reputebereday21 has a reputation beyond reputebereday21 has a reputation beyond reputebereday21 has a reputation beyond repute
Varsaylan Pacalda Ktphane Program Yapma


Ktphane Program


USES CRT,DOS;

type KAYIT=RECORD
adi,soyadi,kitapadi,kitapno,genelucret,aldigitarih :STRING;
F:CHAR;
K:EXTENDED
END;

VAR
KAY:KAYIT;
DOSYA:FILE OF KAYIT;
KOD : INTEGER;
CEVAP:CHAR;
kood:char;
X:WORD;
I,S:INTEGER;
TUS:CHAR;
ARA : STRING;

PROCEDURE M1;FORWARD;
PROCEDURE M2;FORWARD;
PROCEDURE KAYIT1;FORWARD;
PROCEDURE KAYIT2;FORWARD;
PROCEDURE LISTE1;FORWARD;
PROCEDURE LISTE2;FORWARD;
PROCEDURE SILME1;FORWARD;
PROCEDURE SILME2;FORWARD;
{----------------------------------------------------------------------------}
procedure cerceve(x1,y1,x2,y2:byte);
var
k:byte;
begin
gotoxy(x1,y1); write(#201);
for k:=x1+1 to x2-1 do write(#205);
write(#187);
for k:=y1+1 to y2-1 do
begin
gotoxy(x1,k);write(#186);
gotoxy(x2,k);write(#186);
end;
gotoxy(x1,y2);write(#200);
for k:=x1+1 to x2-1 do
write(#205);
write(#188);
end;

PROCEDURE TARIH;
VAR
MAYIS :INTEGER;
A,B,C,D:WORD;
BEGIN
GETDATE(A,B,C,D);
GOTOXY(40,2);WRITE(' TAR˜H ', C,'/',B,'/',A,' ');
END;
{----------------------------------------------------------------------------}
PROCEDURE ZAMAN;
VAR
A,B,C,D:WORD;
BEGIN
GETTIME(A,B,C,D);
GOTOXY(2,2);WRITE(' SAAT ',A,':',B,' ');
END;
{----------------------------------------------------------------------------}
PROCEDURE CEVRE;
BEGIN
GOTOXY(25,10);WRITE(' ');
GOTOXY(57,11);WRITE(' ');
gOTOXY(25,11);WRITE(' ');
GOTOXY(57,12);WRITE(' ');
GOTOXY(25,12);WRITE(' ');
GOTOXY(57,13);WRITE(' ');
GOTOXY(25,13);WRITE(' ');
GOTOXY(57,14);WRITE(' ');
GOTOXY(25,14);WRITE(' ');
GOTOXY(57,15);WRITE(' ');
GOTOXY(25,15);WRITE(' ');
GOTOXY(57,16);WRITE(' ');
GOTOXY(25,16);WRITE(' ');
GOTOXY(57,17);WRITE(' ');
GOTOXY(26,17);WRITE(' ');
END;
{----------------------------------------------------------------------------}
PROCEDURE M1;
VAR
KOD:CHAR;
BEGIN
REPEAT
clrscr;
cerceve(2,2,78,25);
cerceve(23,5,58,19);
GOTOXY(31,8);WRITE('KAYIT [1]');
GOTOXY(31,9);WRITE('L˜STELEME [2]');
GOTOXY(31,10);WRITE('S˜LME [3]');
GOTOXY(31,11);WRITE('ANA MENšYE D™Nš [4]');
GOTOXY(31,13);WRITE(' ... SEC˜M˜N˜Z ... ');
textbackground(blue);
TARIH;
ZAMAN;
textbackground(0);
GOTOXY(52,20);KOD:=READKEY;
IF KOD = '1' THEN KAYIT1;
IF KOD = '2' THEN LISTE1;
iF KOD = '3' THEN SILME1;
UNTIL (KOD='4') OR (KOD=#27);begin clrscr;exit; end;
END;
{----------------------------------------------------------------------------}
PROCEDURE M2;
VAR
KOD:CHAR;
BEGIN
REPEAT
clrscr;
cerceve(2,2,78,25);
cerceve(23,5,58,19);
GOTOXY(31,8);WRITE('CD KAYIT [1]');
GOTOXY(31,9);WRITE('CD L˜STELEME [2]');
GOTOXY(31,10);WRITE('CD S˜LME [3]');
GOTOXY(31,11);WRITE('ANA MENšYE D™Nš [4]');
GOTOXY(31,13);WRITE(' ... SEC˜M˜N˜Z ... ');
textbackground(blue);
TARIH;
ZAMAN;
textbackground(0);
GOTOXY(52,20);KOD:=READKEY;
IF KOD = '1' THEN KAYIT2;
IF KOD = '2' THEN LISTE2;
IF KOD = '3' THEN SILME2;
UNTIL (KOD='4') OR (KOD=#27) ;begin clrscr;exit;end;
END;
{----------------------------------------------------------------------------}

PROCEDURE KAYIT1;
BEGIN
Assign(Dosya,'EMSAT.dat');
{$I-} RESET(DOSYA); KOD:=IORESULT;{$I+}
IF KOD0 THEN REWRITE(DOSYA);
CLRSCR;
tEXTCOLOR(15);
cerceve(5,5,65,19);
GOTOXY(7,3);WRITE('........K˜TAP KAYIT........');
GOTOXY(7,7);WRITE('Alanan ad.....:');
GOTOXY(7,9);WRITE('Alann soyad...:');
GOTOXY(7,11);WRITE('Kitap ad......:');
GOTOXY(7,13);WRITE('Kitap no.......:');
gOTOXY(7,15);WRITE('Genel š‡ret....:');
GOTOXY(7,17);WRITE('Ald tarih...:');
REPEAT
GOTOXY(24,7);READLN(KAY.adi);
UNTIL KAY.ADi'';
REPEAT
GOTOXY(24,9);READLN(KAY.soyadi);
UNTIL KAY.soyadi'';
REPEAT
GOTOXY(24,11);READLN(KAY.kitapadi);
UNTIL KAY.kitapadi'';
REPEAT
GOTOXY(24,13);READLN(KAY.kitapno);
UNTIL KAY.kitapno'';
REPEAT
GOTOXY(24,15);READLN(KAY.genelucret);
UNTIL KAY.genelucret'';
REPEAT
GOTOXY(24,17);READLN(KAY.aldigitarih);
UNTIL KAY.aldigitarih'';
GOTOXY(30,22);WRITE('G˜R˜LEN KAYIT DORU MU ? ');READLN(CEVAP);
CEVAP:=UPCASE(CEVAP);
CASE CEVAP OF
'E': BEGIN
KAY.F:='*';
SEEK(DOSYA,FILESIZE(DOSYA));
WRITE(DOSYA,KAY);
CLOSE(DOSYA);
clrscr;
cevre;
GOTOXY(33,13);WRITE('KAYIT TAMALANDI !');READLN;exit;
END;
'H': exit;
ELSE BEGIN
CEVRE;
GOTOXY(31,12);WRITE('KAYIT TAMAMLANAMADI !');
GOTOXY(30,14);WRITE('LšTFEN TEKRAR DENEY˜N˜Z');
READKEY;
END;
END;
END;
{----------------------------------------------------------------------------}
PROCEDURE LISTE1;
VAR
a,b,c,d,R:WORD;
BEGIN
CLRSCR;
ASSIGN(DOSYA,'EMSAT.DAT');
{$I-} Reset(dosya); KOD:=IORESULT; {$I+}
IF KOD0 THEN REWRITE(DOSYA);
CLRSCR;
gOTOXY(2,2);WRITE(' ');
GOTOXY(5,3);WRITE(' ADI SOYADI K˜TAP ADI NO ALIM TAR˜H˜ F˜ATI ');
GOTOXY(2,4);WRITE(' ');
R:=0;
S:=4;
FOR I:=0 TO FILESIZE(DOSYA)-1 DO
BEGIN
SEEK(DOSYA,I);
READ(DOSYA,KAY);
IF KAY.F='*' THEN BEGIN
R:=R+1;
S:=S+1;
GOTOXY(3,S);WRITE(R:3);
gOTOXY(8,S);WRITE(KAY.adi,' ',KAY.soyadi);
GOTOXY(26,S);WRITE(KAY.kitapadi);
GOTOXY(39,S);WRITE(KAY.kitapno);
GOTOXY(50,S);WRITE(KAY.aldigitarih);
GOTOXY(68,S);WRITE(KAY.genelucret);
gotoxy(66,23);write('Bu gnn Tarihi');
GETDATE(A,B,C,D);
GOTOXY(70,24);WRITE( C,'/',B,'/',A,' ');
END;IF S>15 THEN BEGIN
GOTOXY(64,21);WRITE('D˜ER SAYFA >>>');
TUS:=READKEY;
S:=0;
CLRSCR;
END;
END;
GOTOXY(27,25);WRITE('TšM KAYITLARIN L˜STELENDi ! ');
TUS:=READKEY;
CLOSE(DOSYA);
exit;;
END;
{----------------------------------------------------------------------------}
PROCEDURE SILME1;
VAR
ARA : STRING;
BEGIN
clrscr;
ASSIGN(DOSYA,'EMSAT.DAT');
RESET (DOSYA);
tEXTCOLOR(15);
CEVRE;
TEXTBACKGROUND(0);
GOTOXY(30,12); WRITE('S˜L˜NECEK ˜S˜M˜ YAZINIZ');
GOTOXY(30,14); WRITE(' ................... ');
GOTOXY(32,14); READLN(ARA);
fOR I:= 0 TO FILESIZE(DOSYA)-1 DO
BEGIN
SEEK(DOSYA,I);
READ(DOSYA,KAY);
IF (ARA=KAY.ADi) AND (KAY.F='*') THEN
BEGIN
CLRSCR;
cerceve(5,5,65,19);
GOTOXY(7,7);WRITE('Alanan ad.....:',kay.adi);
GOTOXY(7,9);WRITE('Alann soyad...:',kay.soyadi);
GOTOXY(7,11);WRITE('Kitap ad......:',kay.kitapadi);
GOTOXY(7,13);WRITE('Kitap no.......:',kay.kitapno);
gOTOXY(7,15);WRITE('Genel š‡ret....:',kay.genelucret);
GOTOXY(7,17);WRITE('Ald tarih...:',kay.aldigitarih);
GOTOXY(25,25); WRITE('S˜L˜NECEK KAYIT BU MU ? ');
GOTOXY(53,25);
REPEAT
TUS:=UPCASE(READKEY);
UNTIL TUS IN ['E','H'];
IF TUS='E' THEN
BEGIN
clrscr;
KAY.F:='S';
SEEK(DOSYA,I);
WRITE(DOSYA,KAY);
CEVRE;
TEXTBACKGROUND(0);
GOTOXY(29,13);WRITELN('˜STEN˜LEN KAYIT S˜L˜ND˜ !');
GOTOXY(54,13);READKEY; exit;
CLOSE(DOSYA);
eND;
IF TUS='E' THEN exit;
END;
eND;
END;
{----------------------------------------------------------------------------}
PROCEDURE KAYIT2;
BEGIN
Assign(Dosya,'cd.dat');
{$I-} RESET(DOSYA); KOD:=IORESULT;{$I+}
IF KOD0 THEN REWRITE(DOSYA);
CLRSCR;
cerceve(5,5,65,19);
GOTOXY(7,3);WRITE('........CD KAYIT........');
GOTOXY(7,7);WRITE('Alanan ad.....: ');
GOTOXY(7,9);WRITE('Alann soyad...: ');
GOTOXY(7,11);WRITE('CD ad..........: ');
GOTOXY(7,13);WRITE('CD no...........: ');
gOTOXY(7,15);WRITE('Genel š‡ret.....: ');
GOTOXY(7,17);WRITE('Ald tarih....: ');
REPEAT
GOTOXY(24,7);READLN(KAY.adi);
UNTIL KAY.ADi'';
REPEAT
GOTOXY(24,9);READLN(KAY.soyadi);
UNTIL KAY.soyadi'';
REPEAT
GOTOXY(24,11);READLN(KAY.kitapadi);
UNTIL KAY.kitapadi'';
REPEAT
GOTOXY(24,13);READLN(KAY.kitapno);
UNTIL KAY.kitapno'';
REPEAT
GOTOXY(24,15);READLN(KAY.genelucret);
UNTIL KAY.genelucret'';
REPEAT
GOTOXY(24,17);READLN(KAY.aldigitarih);
UNTIL KAY.aldigitarih'';
GOTOXY(30,22);WRITE('G˜R˜LEN KAYIT DORU MU ? ');READLN(CEVAP);
CEVAP:=UPCASE(CEVAP);
CASE CEVAP OF
'E': BEGIN
KAY.F:='*';
SEEK(DOSYA,FILESIZE(DOSYA));
WRITE(DOSYA,KAY);
CLOSE(DOSYA);
clrscr;
cevre;
GOTOXY(33,13);WRITE('KAYIT TAMALANDI !');READLN;clrscr; exit;
END;
'H': exit;
END;
END;
{----------------------------------------------------------------------------}
PROCEDURE LISTE2;
VAR
a,b,c,d,R:WORD;
BEGIN
CLRSCR;
ASSIGN(DOSYA,'cd.DAT');
{$I-} Reset(dosya); KOD:=IORESULT; {$I+}
IF KOD0 THEN REWRITE(DOSYA);
CLRSCR;
gOTOXY(2,2);WRITE(' ');
GOTOXY(5,3);WRITE(' ADI SOYADI CD ADI CD NO ALIM TAR˜H˜ F˜ATI ');
GOTOXY(2,4);WRITE(' ');
R:=0;
S:=4;
FOR I:=0 TO FILESIZE(DOSYA)-1 DO
BEGIN
SEEK(DOSYA,I);
READ(DOSYA,KAY);
IF KAY.F='*' THEN BEGIN
R:=R+1;
S:=S+1;
GOTOXY(3,S);WRITE(R:3);
gOTOXY(8,S);WRITE(KAY.adi,' ',KAY.soyadi);
GOTOXY(26,S);WRITE(KAY.kitapadi);
GOTOXY(39,S);WRITE(KAY.kitapno);
GOTOXY(50,S);WRITE(KAY.aldigitarih);
GOTOXY(68,S);WRITE(KAY.genelucret);
gotoxy(66,23);write('Bu gnn Tarihi');
GETDATE(A,B,C,D);
GOTOXY(70,24);WRITE( C,'/',B,'/',A,' ');
END;IF S>15 THEN BEGIN
GOTOXY(64,21);WRITE('D˜ER SAYFA >>>');
TUS:=READKEY;
S:=0;
CLRSCR;
END;
END;
GOTOXY(27,25);WRITE('TšM KAYITLARIN L˜STELENDi ! ');
TUS:=READKEY;
CLOSE(DOSYA);
exit;
END;
{----------------------------------------------------------------------------}
PROCEDURE SILME2;
VAR
ARA : STRING;
BEGIN
clrscr;
ASSIGN(DOSYA,'cd.DAT');
RESET (DOSYA);
tEXTCOLOR(15);
CEVRE;
TEXTBACKGROUND(0);
GOTOXY(30,12); WRITE('S˜L˜NECEK ˜S˜M˜ YAZINIZ');
GOTOXY(30,14); WRITE(' ................... ');
GOTOXY(32,14); READLN(ARA);
if ara='' then begin clrscr; exit; end;
fOR I:= 0 TO FILESIZE(DOSYA)-1 DO
BEGIN
SEEK(DOSYA,I);
READ(DOSYA,KAY);
IF (ARA=KAY.ADi) AND (KAY.F='*') THEN
BEGIN
CLRSCR;
cerceve(5,5,65,19);
GOTOXY(7,7);WRITE('Alanan ad.....: ',kay.adi);
GOTOXY(7,9);WRITE('Alann soyad...: ',kay.soyadi);
GOTOXY(7,11);WRITE('Kitap ad......: ',kay.kitapadi);
GOTOXY(7,13);WRITE('Kitap no.......: ',kay.kitapno);
gOTOXY(7,15);WRITE('Genel š‡ret....: ',kay.genelucret);
GOTOXY(7,17);WRITE('Ald tarih...: ',kay.aldigitarih);
GOTOXY(25,25); WRITE('S˜L˜NECEK KAYIT BU MU ? ');
GOTOXY(53,25);
REPEAT
TUS:=UPCASE(READKEY);
UNTIL TUS IN ['E','H'];
IF TUS='E' THEN
BEGIN
clrscr;
KAY.F:='S';
SEEK(DOSYA,I);
WRITE(DOSYA,KAY);
CEVRE;
TEXTBACKGROUND(0);
GOTOXY(29,13);WRITELN('˜STEN˜LEN KAYIT S˜L˜ND˜ !');
GOTOXY(54,13); READKEY; exit;
CLOSE(DOSYA);
end;
IF TUS='H' THEN begin clrscr; exit; end;
END;
eND;
END;
procedure acilis;
const
st1='K ˜ T A P T A K ˜ P';
st2='C D T A K ˜ P';
var
a:integer;
begin
clrscr;
cerceve(2,2,78,25);
repeat
for a:=1 to 10 do
begin
textbackground(a);
textcolor(15);
gotoxy(27,5);write('PROGRAMLAYAN TURBOPASCAL.ORG');
gotoxy(30,8);write('K i T A P T A K i P');
gotoxy(39,10);write('V E');
gotoxy(33,12);write('C D T A K i P');
gotoxy(30,14);write('...P R O G R A M I...');
cerceve(3,22,77,24);
gotoxy(25,23);write('PROGRAMA GiRis i€iN BASINIZ');
delay(300);
textcolor(a);
textbackground(0);
end;
until keypressed;
clrscr;
end;
{----------------------------------------------------------------------------}
BEGIN
clrscr;
acilis;
textcolor(15);
rEPEAT
textbackground(0);
textcolor(15);
clrscr;
cerceve(2,2,78,25);
cerceve(10,6,70,13);
GOTOXY(31,8);WRITE('KiTAP"MI [1] ');
GOTOXY(31,9);WRITE('CD"Mi [2] ');
GOTOXY(31,10);WRITE('CIKIS [3] ');
GOTOXY(26,12);WRITE(' ... SECiMiNiZ .... ');
textbackground(blue);
TARIH;
ZAMAN;
textbackground(0);
GOTOXY(52,20);KooD:=READKEY;
IF KooD = '1' THEN M1;
IF KooD = '2' THEN M2;
UNTIL (KooD='3') OR (KooD=#27);
END.



Az ektirmedi bana ha

bereday21 is offline  
Eski 15-11-2007, 12:03 AM   #2 (permalink)
 
Giri Tarihi: Aug 2006
Konum: C:\WINDOWS\Temp
Ya: 27
Mesaj: 7,867
ye No: 21783
Cinsiyeti : Bay
tibar Gc: 26197
Rep Puan : 2618720
Rep Derecesi
wiyanreklam has a reputation beyond reputewiyanreklam has a reputation beyond reputewiyanreklam has a reputation beyond reputewiyanreklam has a reputation beyond reputewiyanreklam has a reputation beyond reputewiyanreklam has a reputation beyond reputewiyanreklam has a reputation beyond reputewiyanreklam has a reputation beyond reputewiyanreklam has a reputation beyond reputewiyanreklam has a reputation beyond reputewiyanreklam has a reputation beyond repute
Varsaylan


Alnt:
Az çektirmedi bana ha


uzun bir uğraş ister........

ellerine sağlık kekê....

__________________
wiyanreklam is offline  
Eski 15-11-2007, 12:12 AM   #3 (permalink)
 
Giri Tarihi: Sep 2006
Konum: ѕєя∂αя-AmEd==>Sey'r Etme syan Et!<== ihanet vaz gemekle balar.
Ya: 23
Mesaj: 6,037
ye No: 26077
Cinsiyeti : Bay
tibar Gc: 118247
Rep Puan : 11823841
Rep Derecesi
seredare has a reputation beyond reputeseredare has a reputation beyond reputeseredare has a reputation beyond reputeseredare has a reputation beyond reputeseredare has a reputation beyond reputeseredare has a reputation beyond reputeseredare has a reputation beyond reputeseredare has a reputation beyond reputeseredare has a reputation beyond reputeseredare has a reputation beyond reputeseredare has a reputation beyond repute
Varsaylan


walla benim anlamadığım bişey bıu...

__________________
seredare is online now  
 


Konu Aralar
Mod Se

Gnderme Kurallar
Yeni konular aabilirsiniz --> izin yok
Yantlar gnderebilirsiniz --> izin yok
Eklentiler gnderebilirsiniz --> izin yok
Mesajlarnz dzenleyebilirsiniz --> izin yok

[IMG] kodu Ak
HTML kodu Kapal
Trackbacks are Kapal
Pingbacks are Kapal
Refbacks are Kapal

Popler Konular:
Bydigi Forum'un En Popler Konular
Sizin in Setiklerimiz-1:

Norton AntiVirus 2008
Panda Antivirus & Firewall 2008
AVG Anti-Virus Free Edition 8.0.100
McAfee VirusScan Enterprise 8.5i
Avast! 4 Professional Edition 4.8.1169
Kaspersky Internet Security 7.0.1.325
Anti-Porn 10.4.11.15
BitDefender Internet Security 11.0.9 (2008)
Eset Smart Security 3.0.642
Ad-Aware 2008

Sizin in Setiklerimiz-2:

eftali Yetitiricilii
Ekolojik Tarm ve Hayvanclk
St Verimini Etkileyen Faktrler
Drt barajda su bitmek zere
Karbondioksit salm yzde 50’den ok artacak
VAN (Wan) Tarihi
Amed (Diyarbakr) Tarihi
Anadolu Hakknda Genel Bilgi
Kltr ve Turizm Bakanl mfetti yardmcl
2008 yl icra mdr ve yardmcl snav ilan

Sizin in Setiklerimiz-3:

Siz Hangi Yemeksiniz ?
Doum gnnze gre hangi hayvansnz?
Doum Tarihinize Gre Renginiz!
Bebeklerde Gaz karma
Virs tayan keneler dehet sayor
iddetin genlerle ilikisi olabilir
Karpuz Viagra Etkisi Yapyor
Panasonic Sony'yi tahtndan etti!
Mehmet Atl - Wenda 2008
grup seyran - 2008


Benzer Konular

Konu Konuyu Balatan Forum Yant Son Mesaj
Gzel bir foto montaj yapma program kawgamin_cicegi Grafik ve Resim 98 19-02-2008 02:28 AM
Anim-Fx (Flash Banner Yapma Program) jiyana bi rumet Resimli Program Anlatmlar 6 09-03-2007 03:08 PM
Anim-Fx (Flash Banner Yapma Program) SanaLCy Resimli Program Anlatmlar 1 18-08-2006 11:32 AM


Forum saati Trkiye saatine gredir. GMT +2. uan saat: 08:05 AM .
(Trkiye iin GMT +2 seilmelidir.)


Powered by vBulletin Version 3.6.4
Copyright ©2000 - 2008, Jelsoft Enterprises Ltd.
SEO by vBSEO 3.2.0
Copyright 2006 - 2008 Bydigi Forum , All Rights Reserved

Bir Forum sitesi olduumuzdan, kullanclar nceden onay almadan her trl grlerini yazabilmektedir.
Yazlanlardan dolay oluabilecek her trl yasal sorumluluk, yazan kullanclara aittir.
Yinede sitemizde yasalara aykr herhangi bir durum grrseniz; Ltfen, bydigi@gmail.com'a yada letiim'e bildiriniz.
Mesajnz incelenip, ksa bir sre ierisinde gereken mdahale yaplacaktr.