Not: Ascii karakterlerin çıkmamasından dolayı çerçevelerin ascii karşılıklarını yazdım yanlarına süslü parantezle yazdım ki programda da kullanırsanız. Hiç bir şey olmaz.
Bunu yapmakta büyük payı olan Ramazan'ı da unutmak istemiyorum. Bu bizim iki hafta uğraştığımız bir programdı. Dosyanın adı:"Stok.Pas"
uses crt,dos;
var
sayi,a,b,c,d :byte;
sec,tus,x :char;
e,k,t,p :integer;
yil,ay,gun,no:word;
saat,dakika,saniye,sanise:word;
label
kal,bas,orta,son,menu,yaz,oku,duz,sat,tam,silme,ci kis;
procedure Acerceve;
begin
textcolor(14);
gotoxy(80,1);writeln('');{chr(187)}
gotoxy(80,23);writeln('');{chr(188)}
gotoxy(1,1);writeln('');{chr(201)}
gotoxy(1,23);writeln('');{chr(200)}
for a:=2 to 22 do
begin
gotoxy(1,a);writeln('');{chr(186)}
gotoxy(80,a);writeln('');{chr(186)}
end;
for b:=2 to 79 do
begin
gotoxy(b,1);writeln('=');
gotoxy(b,23);writeln('=');
gotoxy(b,21);writeln('=');
gotoxy(b,3);writeln('=');
end;
gotoxy(2,21);writeln('');
gotoxy(1,21);writeln('');
gotoxy(80,21);writeln('');
gotoxy(1,3);writeln('');
gotoxy(80,3);writeln('');
end;
procedure Mcerceve;
begin
textcolor(10);
gotoxy(47,9);writeln('');
gotoxy(47,17);writeln('');
gotoxy(29,9);writeln('');
gotoxy(29,17);writeln('');
for c:=10 to 16 do
begin
gotoxy(29,c);writeln('=');
gotoxy(47,c);writeln('=');
end;
for d:=30 to 46 do
begin
gotoxy(d,9);writeln('=');
gotoxy(d,17);writeln('=');
end;
end;
procedure ufak(var p:integer);
begin
gotoxy(p,17);writeln(' ');
gotoxy(p,18);writeln(' ');
gotoxy(p,19);writeln(' ');
end;
procedure standart(var k:integer);
begin
gotoxy(k,4);writeln(' ');
gotoxy(k,5);writeln(' ');
gotoxy(k,6);writeln(' ');
gotoxy(k,7);writeln(' ');
gotoxy(k,
;writeln(' ');
gotoxy(k,9);writeln(' ');
gotoxy(k,10);writeln(' ');
gotoxy(k,11);writeln(' ');
gotoxy(k,12);writeln(' ');
gotoxy(k,13);writeln(' ');
gotoxy(k,14);writeln(' ');
end;
procedure bilgi;
begin
textcolor(19);
gotoxy(34,9);writeln('ANA MENÜ');
textcolor(15);
gotoxy(29,6);writeln('STOK TAKİP PROGRAMI');
TEXTCOLOR(11);textbackground(0);
gotoxy(2,2);writeln('PROG.ADI:');
gotoxy(32,2);writeln('YAZAN:');
gotoxy(60,2);writeln('TARİH:');
gotoxy(62,20);writeln('SAAT:');
TEXTCOLOR(13);
gotoxy(11,2);writeln('STOK BİLGİLERİ');
gotoxy(39,2);writeln('MUSTAFA SERT');
gotoxy(66,2);writeln(yil,'/',ay,'/',gun);
TEXTCOLOR(11);
gotoxy(2,22);writeln('F1: F2: F3: F4: F5: F6: ESC:');
TEXTCOLOR(12);
gotoxy(5,22);writeln('KAY.GİR');
gotoxy(16,22);writeln('KAY.OKU');
gotoxy(27,22);writeln('KAY.DÜZ');
gotoxy(38,22);writeln('LİS.EKR');
gotoxy(49,22);writeln('LİS.YAZ');
gotoxy(60,22);writeln('KAY.SİL');
gotoxy(72,22);writeln('ÇIKIŞ');
END;
procedure gel;
begin
TEXTCOLOR(15);
gotoxy(30,10);writeln('1-KAYIT GİRİŞİ');
gotoxy(30,11);writeln('2-KAYIT OKUMA');
gotoxy(30,12);writeln('3-KAYIT DÜZELTME');
gotoxy(30,13);writeln('4-LİSTELEME(SAT)');
gotoxy(30,14);writeln('5-LİSTELEME(TAM)');
gotoxy(30,15);writeln('6-KAYIT SİLME');
gotoxy(30,16);writeln('7-ÇIKIŞ');
end;
procedure temizle;
begin
gotoxy(2,4);writeln(' ');
gotoxy(2,5);writeln(' ');
gotoxy(2,6);writeln(' ');
gotoxy(2,7);writeln(' ');
gotoxy(2,
;writeln(' ');
gotoxy(2,9);writeln(' ');
gotoxy(2,10);writeln(' ');
gotoxy(2,11);writeln(' ');
gotoxy(2,12);writeln(' ');
gotoxy(2,13);writeln(' ');
gotoxy(2,14);writeln(' ');
gotoxy(2,15);writeln(' ');
gotoxy(2,16);writeln(' ');
gotoxy(2,17);writeln(' ');
gotoxy(2,18);writeln(' ');
gotoxy(2,19);writeln(' ');
gotoxy(2,20);writeln(' ');
end;
procedure ekrbil(var t:integer);
begin
TEXTCOLOR(14);
gotoxy(t,5);writeln('ÜRÜNÜN KODU....:');
gotoxy(t,7);writeln('ÜRÜNÜN ADI.....:');
gotoxy(t,9);writeln('ÜRÜNÜN MARKASI.:');
gotoxy(t,11);writeln('ÜRÜNÜN MİKTARI.:');
gotoxy(t,13);writeln('ÜRÜNÜN FİYATI..:');
END;
procedure kaygir;
type
kayit=record
kod:integer;
Ad:string[10];
mrk:string[10];
mik:integer;
fyt:longint;
kkd:string[1];
end;
var
depolama:file of kayit;
kay:kayit;
kk,nn:string;
i:integer;
label
bitir,gel,gelme,x,bas;
begin
assign(depolama,'c:\stok.dat');
{$I-} reset(depolama); i:=ioresult; {$I+}
if (i<>0) then rewrite(depolama);
gelme:
gotoxy(10,15);write(' ');
gotoxy(15,16);write(' ');
gotoxy(15,18);write(' ');
gotoxy(20,19);write(' ');
textcolor(15);
k:=20;
standart(k);
t:=21;
ekrbil(t);
gel:
textcolor(14);
gotoxy(2,22);writeln(' ');
gotoxy(39,5);readln(kay.kod);
gotoxy(39,7);readln(kay.ad);
gotoxy(39,9);readln(kay.mrk);
gotoxy(39,11);readln(kay.mik);
gotoxy(39,13);readln(kay.fyt);
kay.kkd:='D';
gotoxy(14,15);write('VERİLERİN DOĞRULUĞUNU KABUL EDİYOR MUSUNUZ? E/H... ');
readln(kk);
if ((kk='H') or (kk='h')) then goto gelme;
if ((kk='E') or (kk='e')) then
begin
WRITE(DEPOLAMA,KAY);
gotoxy(35,18);write('kayıt yazıldı.');textcolor(11);
gotoxy(2,22);write('BAŞKA KAYIT YAZMAK İÇİN <E> GİRİNİZ :');readln(nn);
x:
if ((nn='H') or (nn='h')) then goto bitir;
if ((nn='E') or (nn='e')) then goto gelme;
end;
CLOSE(DEPOLAMA);
bitir:
end;
procedure kayoku;
type
kayit=record
kod:integer;
Ad:string[10];
mrk:string[10];
mik:integer;
fyt:longint;
kkd:string[1];
end;
var
depolama:file of kayit;
kay:kayit;
kk:string;
cev:string;
i,kod,kan:integer;
d:char;
label
bitir,bas,bit;
begin
assign(depolama,'c:\stok.dat');
{$I-} reset(depolama); kan:=ioresult; {$I+}
if kan <> 0 then begin
gotoxy(25,18);writeln('dosya yok.....');
end;
bas:
textcolor(15);
k:=20;
standart(k);
t:=21;
ekrbil(t);
GOTOXY(2,22);WRITE(' ');
gotoxy(20,16);write('OKUNACAK ÜRÜNÜN KODUNU GİRİNİZ....:');READLN(KOD);
for i:=0 to filesize(depolama)-1 do
begin
seek(depolama,i);
read(depolama,kay);
IF (kay.kkd='D') and (kay.kod=kod) then
begin
textcolor(14);
gotoxy(39,5);writeln(kay.kod);
gotoxy(39,7);writeln(kay.ad);
gotoxy(39,9);writeln(kay.mrk);
gotoxy(39,11);writeln(kay.mik);
gotoxy(39,13);writeln(kay.fyt);
goto bitir;
end
else begin
gotoxy(27,18);writeln('böyle bir kayıt yok');
end;
end;
bitir:
textcolor(11);
gotoxy(2,22);write('BAŞKA KAYIT OKUYACAKSANIZ [e/E] GİRİNİZ :');
readln(cev);
if (cev='e') or (cev='E') then begin
gotoxy(55,16);write(' ');
gotoxy(25,18);writeln(' ');
goto bas end else goto bit;
bit:
close(depolama);
end;
procedure kayduz;
type
kayit=record
kod:integer;
Ad:string[10];
mrk:string[10];
mik:integer;
fyt:longint;
kkd:string[1];
end;
var
depolama:file of kayit;
kay:kayit;
ykod,ymik:integer;
yfyt:longint;
ymrk:string[10];
yad:string[10];
mm,ss:string[1];
i,kod:integer;
label yeni,sonlan,iste,tek,eski;
begin
assign(depolama,'c:\stok.dat');
{$I-} reset(depolama); i:=ioresult; {$I+}
if (i<>0) then rewrite(depolama);
iste:
textcolor(15);
k:=4;
standart(k);
t:=5;
ekrbil(t);
gotoxy(2,22);writeln(' ');
gotoxy(20,16);write('Düzeltilecek kaydın kodunu giriniz:');readln(kod);
for i:=0 to filesize (depolama)-1 do
begin
seek(depolama,i);
read(depolama,kay);
IF (kay.kkd='D') and (kay.kod=kod) then
begin
gotoxy(24,5);writeln(kay.kod);
gotoxy(24,7);writeln(kay.ad);
gotoxy(24,9);writeln(kay.mrk);
gotoxy(24,11);writeln(kay.mik);
gotoxy(24,13);writeln(kay.fyt);
end
else
begin gotoxy(35,18);writeln('Böyle bir kayit yok');
goto eski;end;
textcolor(13);
tek:
gotoxy(19,16);write(' ');
gotoxy(5,16);write('Düzeltilecek kayit bu mu? [E\H]:');readln(mm);
if ((mm='E') or (mm='e')) then goto yeni
else gotoxy(5,16);write(' ');
goto iste;
yeni:
textcolor(15);
k:=40;
standart(k);
t:=41;
ekrbil(t);
gotoxy(59,5);readln(kay.kod);
gotoxy(59,7);readln(kay.ad);
gotoxy(59,9);readln(kay.mrk);
gotoxy(59,11);readln(kay.mik);
gotoxy(59,13);readln(kay.fyt);
seek(depolama,i);
write (depolama,kay);
gotoxy(5,16);write(' ');
p:=26;
ufak(p);
textcolor(12);gotoxy(30,18);writeln('kayit düzeltildi');
eski:
textcolor(11);
gotoxy(2,22);write('Başka kayıt düzeltmek için [E\e] giriniz:');readln(ss);
if (ss='E') or (ss='e') then begin
temizle;
goto iste;
end
else goto sonlan;
close(depolama);
end;
sonlan:
end;
procedure kayitsil;
type
kayit=record
kod:integer;
Ad:string[10];
mrk:string[10];
mik:integer;
fyt:longint;
kkd:string[1];
end;
var
depolama:file of kayit;
kay:kayit;
kk,pp:string;
cev:string;
i,kod:integer;
mm:string;
label
bitir,bas,bitir1;
begin
assign(depolama,'c:\stok.dat');
reset(depolama);
bas:
textcolor(15);
k:=20;
standart(k);
t:=21;
ekrbil(t);
gotoxy(2,22);writeln(' ');
gotoxy(20,16);write('SİLİNECEK KAYDIN KODUNU GİRİNİZ....');READLN(KOD);
{for i:=0 to filesize(depolama)-1 do}
begin
seek(depolama,i);
read(depolama,kay);
IF (kay.kkd='D') and (kay.kod=kod) then
begin
textcolor(14);
gotoxy(39,5);writeln(kay.kod);
gotoxy(39,7);writeln(kay.ad);
gotoxy(39,9);writeln(kay.mrk);
gotoxy(39,11);writeln(kay.mik);
gotoxy(39,13);writeln(kay.fyt);
gotoxy(22,18);write('Silinecek Kayıt Bu mu? [E\H]: ');readln(mm);
if (mm='E') or (mm='e') then
begin
kay.kkd:='S';
seek(depolama,i);
WRITE(DEPOLAMA,KAY);
gotoxy(22,18);write(' ');gotoxy(52,18);write(' ');
p:=25;
ufak(p);
gotoxy(30,18);write('Kayıt Silindi....');
goto bitir;
end;
if (mm='H') or (mm='h') then
begin
gotoxy(20,18);write(' ');
gotoxy(25,19);writeln('Kayıt Silme İşlemi Gerçeleşmedi...');
goto bitir;
end;
end
else begin gotoxy(28,18);write('Böyle bir kayıt yok');
end;
bitir:
textcolor(11);
gotoxy(2,22);write('Başka kayıt silmek için [E\e] giriniz:');readln(pp);
if (pp='E') or (pp='e') then begin
temizle;
goto bas;
end
else goto bitir1;
end;
bitir1:
close(depolama);
end;
procedure ekrlis;
type
kayit=record
kod:integer;
Ad:string[10];
mrk:string[10];
mik:integer;
fyt:longint;
kkd:string[1];
end;
var
depolama:file of kayit;
kay:kayit;
p:byte;
cev:string;
i,kod:integer;
label
bitir,bas;
begin
assign(depolama,'c:\stok.dat');
{$I-} reset(depolama);i:=ioresult; {$I+}
if (i<>0) then begin
gotoxy(15,23);write('dosya yok');
end;
bas:
clrscr;
writeln(' KODU ADI MARKASI MİKTARI FİYATI');
WRITELN('_________________________________________ ___________________________________');
p:=3;
FOR i:=0 to filesize(depolama)-1 do
begin
seek(depolama,i);
read(depolama,kay);
if kay.kkd='D' then
begin
p:=p+1;
gotoxy(3,p);writeln(kay.kod);
gotoxy(18,p);writeln(kay.ad);
gotoxy(35,p);writeln(kay.mrk);
gotoxy(54,p);writeln(kay.mik);
gotoxy(68,p);writeln(kay.fyt);
end;
if p>18 then
begin
gotoxy(20,21);write('bir tuşa basınız....');readkey;
p:=0;
clrscr;
end;
end;
gotoxy(20,21);write('Listelenecek kayıtlar bitti....');
readkey;
close(depolama);
bitir:
end;
procedure ekrtam;
type
kayit=record
kod:integer;
Ad:string[10];
mrk:string[10];
mik:integer;
fyt:longint;
kkd:string[1];
end;
var
depolama:file of kayit;
kay:kayit;
p:byte;
cev:string;
z :char;
i,kod:integer;
label
come,son,bitir,bas;
begin
assign(depolama,'c:\stok.dat');
{$I-} reset(depolama);i:=ioresult; {$I+}
if (i<>0) then begin
gotoxy(15,23);write('dosya yok');
end;
kay.kod:=1;
bas:
clrscr; k:=20;standart(k);t:=21;ekrbil(t);
kay.kod:=kay.kod+1;
seek(depolama,i);
read(depolama,kay);
if kay.kkd='D' then
begin
gotoxy(39,5);writeln(kay.kod);
gotoxy(39,7);writeln(kay.ad);
gotoxy(39,9);writeln(kay.mrk);
gotoxy(39,11);writeln(kay.mik);
gotoxy(39,13);writeln(kay.fyt);
end;
come:
gotoxy(18,15);write('DİĞER KAYIT İÇİN <ENTER> ÇIKIŞ İÇİN <ESC> BASINIZ..');
z:=readkey;
if (z=#13) then goto bas;
if (z=#27) then goto son
else goto come;
son:
close(depolama);
end;
{ANA PROGRAM}
BEGIN
menu:
textbackground(0);
sayi:=0;
clrscr;
GETDATE(yil,ay,gun,no);
Acerceve;
Mcerceve;
bilgi;
gel;
textbackground(12);textcolor(15);gotoxy(30,10);wri teln('1-KAYIT GİRİŞİ');
textbackground(0);textcolor(15);
gotoxy(29,18);write('SEÇİMİNİZİ GİRİNİZ...[ ]');
gotoxy(51,18);
repeat
repeat
textcolor(14);
gettime(saat,dakika,saniye,sanise);
if saniye>10 then
begin
gotoxy(68,20);writeln(saat,':', dakika,':',saniye);
end;
if saniye<10 then
begin
gotoxy(68,20);writeln(saat,':', dakika,':0',saniye);
end;
gotoxy(51,18);
delay(1000);
until keypressed;
kal:
textbackground(0);textcolor(15);
e:=1 ;
repeat
if (e=1) then textbackground(12) else textbackground(0);gotoxy(30,10);writeln('1-KAYIT GİRİŞİ');
if (e=2) then textbackground(12) else textbackground(0);gotoxy(30,11);writeln('2-KAYIT OKUMA');
if (e=3) then textbackground(12) else textbackground(0);gotoxy(30,12);writeln('3-KAYIT DÜZELTME');
if (e=4) then textbackground(12) else textbackground(0);gotoxy(30,13);writeln('4-LİSTELEME(SAT)');
if (e=5) then textbackground(12) else textbackground(0);gotoxy(30,14);writeln('5-LİSTELEME(TAM)');
if (e=6) then textbackground(12) else textbackground(0);gotoxy(30,15);writeln('6-KAYIT SİLME');
if (e=7) then textbackground(12) else textbackground(0);gotoxy(30,16);writeln('7-CIKIŞ');textbackground(0);
gotoxy(51,18);
X:=READKEY;
if (x=#80) then e:=e+1;
if (x=#72) then e:=e-1;
if (x=#59) or (x='1') then goto yaz;
if (x=#60) or (x='2') then goto oku;
if (x=#61) or (x='3') then goto duz;
if (x=#62) or (x='4') then goto sat;
if (x=#63) or (x='5') then goto tam;
if (x=#64) or (x='6') then goto silme;
if (x=#27) or (x='7') then goto cikis;
if e>7 then e:=1;
if e<1 then e:=7;
if x=#27 then e:=7;
until (x=#27) or (x=#13);
if e=1 then goto yaz;
if e=2 then goto oku;
if e=3 then goto duz;
if e=4 then goto sat;
if e=5 then goto tam;
if e=6 then goto silme;
if e=7 then goto cikis;
until keypressed;
yaz:
textcolor(12);
temizle;
kaygir;
goto menu;
oku:
temizle;
kayoku;
goto menu;
duz:
temizle;
{aciklama3;}
kayduz;
goto menu;
sat:
temizle;
ekrlis;
readln;goto menu;
tam:
temizle;
ekrtam;
readln;goto menu;
silme:
temizle;
kayitsil;
goto menu;
cikis:
temizle;gotoxy(3,20);write('Programdan Çıktınız.');
gotoxy(2,22);writeln(' ');
readln;
END.
İyi çalışmalar
Anasayfa 
Latest images 
Konu: Stok Takip Programı 
