Pacalda Kütüphane Programı Yapma

Co Admin Mesaj Sayısı : 220 Kayıt tarihi : 25/09/08 Yaş : 34

Kütüphane 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, Cool

;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, Cool

;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 DO¦RU 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 DO¦RU 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, Cool

;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, Cool

;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.

» k750i için tema yapma programı
» Pascal'da KDV Hesaplama programı
» Advanced Device Locks FuLL Türkçe-[Sorunsuz ve kasmayan bir şifreleme programı]