Programalama > PASCAL

Program malzeme_kayit_1_0;
Uses crt;
Type
kayit_Tipi = Record
malzeme : string[50];
ozel,miktar:string[15];
fiyat:string[20];
toplam:string;
satis:string[10];
durum:char;
end;

Var
kayit:kayit_tipi;
dosya:file of kayit_tipi;
tus:char;

Procedure renk(y,z:byte);
begin
textcolor(y);textbackground(z);
end;

function DosyaVarMi(DosyaAdi: String): Boolean;
var
F: file;
begin
{$I-}
Assign(F, DosyaAdi);
Reset(F);
Close(F);
{$I+}
DosyaVarMi := (IOResult = 0) and (DosyaAdi <> '');
end;

Procedure DosyayiAc;
begin
if dosyavarmi('pektas.MP3') then begin
assign(dosya,'pektas.MP3');
reset(dosya);
end else begin
assign(dosya,'pektas.MP3');
rewrite(dosya);
end;
end;

Procedure YeniKayit;
Begin Clrscr;
write('MALZEME ADI..: ');readln(kayit.malzeme);
write('B&#732;R&#732;M F&#732;YATI......: ');readln(kayit.fiyat);
write('&#8482;ZELL&#732;KLER&#732;......: ');readln(kayit.ozel);
write('M&#732;KTAR......');readln(kayit.miktar);
write('TOPLAM F&#732;YAT....');readln(kayit.toplam);
write('SATI&#382; TAR&#732;H&#732;....');readln(kayit.satis);
readln(kayit.satis);
kayit.durum:='+';
seek(dosya,filesize(dosya));
write(dosya,kayit);
End; {yenikayit}

Procedure IsmeGoreAra;
var
ad : string[50];
a:longint;
tus2:char;
begin clrscr;
write('ARANACAK MALZEME ADI: ');readln(ad);
for a:=0 to filesize(dosya)-1 do begin
seek(dosya,a);read(dosya,kayit);
if (pos(ad,kayit.malzeme)>0) and (kayit.durum='+') then begin
writeln('MALZEME ADI..:', kayit.malzeme);
writeln('B&#732;R&#732;M F&#732;YATI.:', kayit.fiyat);
writeln('&#8482;ZELL&#732;KLER&#732;.:', kayit.ozel);
writeln('M&#732;KTARI:', kayit.miktar);
writeln('TOPLAM F&#732;YAT...:', kayit.toplam);
writeln('SATI&#382; TAR&#732;H&#732;:', kayit.satis);
tus2:=readkey;
end; {if pos..}
end; {for a..}
end; {ismegore..}

Procedure TumunuListele;
var
a:longint;
tus2:char;
begin clrscr;
renk(0,15);
gotoxy(1,1);write(' ':80);
gotoxy(1,1);write('MALZEME ADI');
gotoxy(40,1);write('M&#732;KTAR');
gotoxy(60,1);writeln('&#8482;ZELL&#732;K');
renk(lightgray,0);
for a:=0 to filesize(dosya)-1 do
if kayit.durum='+' then begin
seek(dosya,a);read(dosya,kayit);
write(kayit.malzeme);
gotoxy(40,wherey);write(kayit.miktar);
gotoxy(60,wherey);write(kayit.ozel);
if wherey=24 then begin
tus2:=readkey;
clrscr;
renk(0,15);
gotoxy(1,1);write(' ':80);
gotoxy(1,1);write('MALZEME ADI');
gotoxy(40,1);write('F&#732;YATI');
gotoxy(60,1);writeln('&#8482;ZELL&#732;K');
renk(lightgray,0);
end; {if wherey..}
end; {for a..}
tus2:=readkey;
end;


Procedure KayitIptal;
var
ad : string[50];
a:longint;
tus2:char;
begin clrscr;
write('Silincek isim: ');readln(ad);
for a:=0 to filesize(dosya)-1 do begin
seek(dosya,a);
read(dosya,kayit);
if (pos(ad,kayit.malzeme)>0) and (kayit.durum='+') then begin
writeln('MALZEME ADI..:', kayit.malzeme);
writeln('F&#732;YATI.:', kayit.fiyat);
writeln('&#8482;ZELL&#732;K.:', kayit.ozel);
writeln('M&#732;KTAR:', kayit.miktar);
writeln('TOPLAM F&#732;YAT..:', kayit.toplam);
writeln('SATI&#382; TAR&#732;H&#732;', kayit.satis);
writeln;
write('Silincek Kayt bu mu (E/H) ? : ');
repeat
tus2:=readkey;
until tus2 in['e','E','h','H',#27];
case tus2 of
'e','E': begin
kayit.durum:='-';
seek(dosya,a);write(dosya,kayit);
end; {'e','E':..}
end; {case}
end; {if pos..}
end; {for a..}
end; {kayitiptal}
Begin
dosyayiAc;
Repeat clrscr;
TEXTCOLOR(2);
gotoxy(32,4);writeln('***** MEN&#353; *****');
writeln;
gotoxy(32,6);writeln(':1: YEN&#732; KAYIT');
gotoxy(32,7);writeln(':2: &#732;SME G&#8482;RE ARA');
gotoxy(32,8);writeln(':3: T&#353;M&#353;N&#353; L&#732;STELE');
gotoxy(32,9);writeln(':4: KAYIT &#732;PTAL');
write('5-fatih');
gotoxy(32,10);writeln(':6: &#8364;IKI&#382;');
writeln;
textcolor(9);gotoxy(32,13);write('Se&#8225;iminiz..:');
tus:=readkey;
case tus of
'1':yenikayit;
'2':ismegoreara;
'3':tumunulistele;
'4':kayitiptal;
end;
Until tus in['5',#27];
close(dosya);
end.