Pascalda Bir Takip programi - Programlama- Zamansız Tartışma Platform

Yσкє∂!¢! · 30-12-07, 20:35 Çevrimdışı

Pascalda takip programi Hos bir takip programi uses crt;
type
kayit=record
Isimtring[20];
Soyadtring[20];
Meslektring[20];
Sehirtring[20];
Telefontring[12];
f:char;
end;
var
dosya:file of kayit;
kay:kayit;
tus,t:char;
i,kod:integer;
{************************************************* *************}
procedure cerceve(x1,y1,x2,y2:byte);
var
i:integer;
cizgitring[80];
begin
fillchar(cizgi,x2-x1,#196);
cizgi[0]:=chr(x2-x1-1);
gotoxy(x1,y1);write(chr(218),cizgi,chr(191));
for i:=y1+1 to y2-1 do
begin
gotoxy(x1,i);write(chr(179));
gotoxy(x2,i);write(chr(179));
end;
gotoxy(x1,y2);write(chr(192),cizgi,chr(217));
end;
{************************************************* ********}
procedure kayityap;
begin
assign(dosya,''Meslek.dat'');
{$i-}reset(dosya);kod:=ioresult;{$i+};
if kod<>0 then rewrite(dosya);
repeat
clrscr;
cerceve(10,5,70,15);
gotoxy(15,7);write(''Isim............:'');readln(k ay.Isim);
if kay.isim='''' then
begin
close(dosya);exit;
end;
gotoxy(15,9);write(''Meslek..........:'');readln(k ay.Meslek);
gotoxy(15,11);write(''Sehir...........:'');readln( kay.Sehir);
gotoxy(15,13);write(''Telefon.........:'');readln( kay.Telefon);
cerceve(10,16,70,18);
gotoxy(25,17);write(''Bilgi Dosyaya Yazilsin Mi? [E/H]'');
repeat
tus:=upcase(readkey);
until tus in [''E'',''H''];
if tus=''E'' then
begin
kay.f:=''*'';
seek(dosya,filesize(dosya));
write(dosya,kay);
end;
until 1=2;
end;
{************************************************* *******}
procedure listeleme;
var
s:integer;
begin
assign(dosya,''Meslek.dat'');
{$i-}reset(dosya);i:=ioresult;{$i+}
if i<>0 then
begin
writeln(''!!!Dosya Yok!!!'');
tus:=readkey;halt;
end;
clrscr;
writeln(''AD MESLEK SEHIRTELEFON'');
writeln(''________________________________________ ___________________________'');
window(1,3,80,25);
s:=0;
for i:=0 to filesize(dosya)-1 do
begin
seek(dosya,i);read(dosya,kay);
if kay.f=''*'' then
begin
s:=s+1;
gotoxy(1,s);write(kay.Isim);
gotoxy(17,s);write(kay.Meslek);
gotoxy(39,s);write(kay.Sehir);
gotoxy(60,s);write(kay.telefon);
end;
if s>18 then
begin
gotoxy(20,21);
write(''Diger Sayfa I‡in Bir Tusa Basiniz...'');
tus:=readkey;
s:=0;
clrscr;
end;
end;
gotoxy(20,21);write(''Listelenecek Kayitlar Bitti!...'');
tus:=readkey;
window(1,1,80,25);
close(dosya);
end;
{************************************************* *******************}
procedure arama;
var
aratring[30];
begin
assign(dosya,''Meslek.dat'');
{$i-}reset(dosya);kod:=ioresult;{$i+}
if kod<>0 then
begin
gotoxy(20,20);write(''!!!Dosya Yok!!!'');
tus:=readkey;exit;
end;
repeat
clrscr;
cerceve(20,3,60,5);
gotoxy(22,4);write(''Aradiginiz Isim:'');readln(ara);
if ara='''' then
begin
close(dosya);exit;
end;
for i:=0 to filesize(dosya)-1 do
begin
seek(dosya,i);
read(dosya,kay);
if (kay.f=''*'') and (kay.Isim=ara) then
begin
clrscr;
cerceve(10,5,70,15);
gotoxy(15,7);writeln(''Isim...........:'',kay.Isim );
gotoxy(15,9);writeln(''Meslek.........:'',kay.Mesl ek);
gotoxy(15,11);writeln(''Sehir..........:'',kay.Seh ir);
gotoxy(15,13);writeln(''Telefon........:'',kay.Tel efon);
cerceve(10,16,70,18);
gotoxy(25,17);write(''Aradiginiz Kayit Bu Mu? [E/H]'');
repeat
tus:=upcase(readkey);
until tus in [''E'',''H''];
if tus=''E'' then
begin
close(dosya);exit;
end;
end;
end;
writeln;
cerceve(10,16,70,18);
gotoxy(15,17);write(''Aradiginiz Kayit Yok.Devam Etmek I‡in Bir Tusa Basiniz.'');
tus:=readkey;
until 1=2;
end;
{************************************************* ***************************}
procedure Duzeltme;
var
aratring[30];
begin
assign(dosya,''Meslek.dat'');
{$i-}reset(dosya);kod:=ioresult;{$i+}
if kod<>0 then
begin
gotoxy(20,20);write(''!!!Dosya Yok!!!....'');
tus:=readkey;
exit;
end;
clrscr;
cerceve(20,3,60,5);
gotoxy(22,4);write(''D�zeltilecek Isim:'');readln(ara);
for i:=0 to filesize(dosya)-1 do
begin
seek(dosya,i);read(dosya,kay);
if (ara=kay.Isim) and (kay.f=''*'') then
begin
clrscr;
cerceve(10,5,70,15);
gotoxy(15,7);writeln(''Isim...........:'',kay.Isim );
gotoxy(15,9);writeln(''Meslek.........:'',kay.Mesl ek);
gotoxy(15,11);writeln(''Sehir..........:'',kay.Seh ir);
gotoxy(15,13);writeln(''Telefon........:'',kay.Tel efon);
cerceve(10,16,70,18);
gotoxy(25,17);write(''Aradiginiz Kayit Bu Mu? [E/H]'');
repeat
tus:=upcase(readkey);
until tus in [''E'',''H''];
if tus=''E'' then
repeat
clrscr;
cerceve(10,5,70,17);
gotoxy(15,7);writeln(''1-Isim...........:'',kay.Isim);
gotoxy(15,9);writeln(''2-Meslek.........:'',kay.Meslek);
gotoxy(15,11);writeln(''3-Sehir..........:'',kay.Sehir);
gotoxy(15,13);writeln(''4-Telefon........:'',kay.Telefon);
gotoxy(15,15);writeln(''5-Islem Sonu'');
cerceve(10,18,70,20);
gotoxy(20,19);writeln(''Se‡iminiz (1..5) (Esc=iptal):'');
repeat
tus:=readkey;
until tus in[''1''..''5'',#27];
if tus<>#27 then cerceve(10,21,70,23);
case tus of
''1'':begin
gotoxy(15,22);
write(''Isim..........:'');readln(kay.Isim);
end;
''2'':begin
gotoxy(15,22);
write(''Meslek........:'');readln(kay.Meslek);
end;
''3'':begin
gotoxy(15,22);
write(''Sehir.........:'');readln(kay.Sehir);
end;
''4'':begin
gotoxy(15,22);
write(''Telefon.......:'');readln(kay.Telefon);
end;
''5'':begin
seek(dosya,i);
write(dosya,kay);
gotoxy(20,22);
write(''Islem Tamamlandi...'');
close(dosya);
tus:=readkey;exit;
end;
#27:exit;
end;
until 1=2;
end;
end;
gotoxy(20,20);write(''!!!Kay�t Yok!!!'');
close(dosya);
tus:=readkey;
end;
{************************************************* **************************}
procedure silme;
var
aratring[20];
begin
assign(dosya,''Meslek.dat'');
{$i-}reset(dosya);kod:=ioresult;{$i+}
if kod<>0 then
begin
gotoxy(20,20);write(''!!!Dosya Yok!!!'');
tus:=readkey;exit;
end;
clrscr;
cerceve(10,3,70,5);
gotoxy(15,4);write(''Silinecek Isim:'');readln(ara);
for i:=0 to filesize(dosya)-1 do
begin
seek(dosya,i);read(dosya,kay);
if (ara=kay.Isim) and (kay.f=''*'') then
begin
clrscr;
cerceve(10,5,70,15);
gotoxy(15,7);writeln(''Isim...........:'',kay.Isim );
gotoxy(15,9);writeln(''Meslek.........:'',kay.Mesl ek);
gotoxy(15,11);writeln(''Sehir..........:'',kay.Seh ir);
gotoxy(15,13);writeln(''Telefon........:'',kay.Tel efon);
cerceve(10,16,70,18);
gotoxy(25,17);write(''Silinecek Kayit Bu Mu? [E/H]'');
repeat
tus:=upcase(readkey);
until tus in [''E'',''H''];
if tus=''E'' then
begin
kay.f:=''s'';
seek(dosya,i);write(dosya,kay);
gotoxy(20,20);write(''Kayit Silindi!...'');
close(dosya);
tus:=readkey;
exit;
end;
end;
end;
gotoxy(20,20);write(''!!!Kayit Yok!!!'');
close(dosya);tus:=readkey;
end;
{************************************************* *********************}
procedure ekran;
begin
clrscr;
cerceve(1,1,80,24);
cerceve(3,2,78,4);
cerceve(3,5,20,20);
cerceve(22,5,60,7);
cerceve(22,8,60,23);
cerceve(62,5,78,20);
cerceve(3,21,20,23);
cerceve(62,21,78,23);
gotoxy(27,3);write(''TELEFON TAKIP PROGRAMI'');
gotoxy(27,6);write(''Design by restart_on'');
end;
{************************************************* **************************}
begin
repeat
ekran;
gotoxy(30,10);write(''1-Bilgi Girisi'');
gotoxy(30,12);write(''2-Bilgi Listesi'');
gotoxy(30,14);write(''3-Bilgi Arama'');
gotoxy(30,16);write(''4-Bilgi D�zeltme'');
gotoxy(30,18);write(''5-Bilgi Silme'');
gotoxy(30,20);write(''Se‡iminiz (Esc=Cikis):'');
repeat
t:=readkey;
if t=#27 then halt;
until t in[''1''..''5'',#27.);
case t of
''1'':Kayityap;
''2'':Listeleme;
''3'':Arama;
''4''uzeltme;
''5''[img]smileys/smiley5.gif[/img]ilme;
end;
until false;
end.

Smileylerden Dolayi Kodlari alamiyorsaniz Tiklayin

askkorsani · 31-07-08, 12:28 Çevrimdışı

Bu ne

30-12-07, 20:35 Çevrimdışı	#1
Rektör Yσкє∂!¢! Huzur Pınarı Genel Mesajlar: 6.753 Teşekkür etti: 2.211 Teşekkür edildi: 3.206 RepForum Gücü: 102 Forum Puanı:38822 Ruhsal Durumum:	Pascalda Bir Takip programi Pascalda takip programi Hos bir takip programi uses crt; type kayit=record Isimtring[20]; Soyadtring[20]; Meslektring[20]; Sehirtring[20]; Telefontring[12]; f:char; end; var dosya:file of kayit; kay:kayit; tus,t:char; i,kod:integer; {*********************************************** *********} procedure cerceve(x1,y1,x2,y2:byte); var i:integer; cizgitring[80]; begin fillchar(cizgi,x2-x1,#196); cizgi[0]:=chr(x2-x1-1); gotoxy(x1,y1);write(chr(218),cizgi,chr(191)); for i:=y1+1 to y2-1 do begin gotoxy(x1,i);write(chr(179)); gotoxy(x2,i);write(chr(179)); end; gotoxy(x1,y2);write(chr(192),cizgi,chr(217)); end; {********************************************* *****} procedure kayityap; begin assign(dosya,''Meslek.dat''); {$i-}reset(dosya);kod:=ioresult;{$i+}; if kod<>0 then rewrite(dosya); repeat clrscr; cerceve(10,5,70,15); gotoxy(15,7);write(''Isim............:'');readln(k ay.Isim); if kay.isim='''' then begin close(dosya);exit; end; gotoxy(15,9);write(''Meslek..........:'');readln(k ay.Meslek); gotoxy(15,11);write(''Sehir...........:'');readln( kay.Sehir); gotoxy(15,13);write(''Telefon.........:'');readln( kay.Telefon); cerceve(10,16,70,18); gotoxy(25,17);write(''Bilgi Dosyaya Yazilsin Mi? [E/H]''); repeat tus:=upcase(readkey); until tus in [''E'',''H'']; if tus=''E'' then begin kay.f:=''''; seek(dosya,filesize(dosya)); write(dosya,kay); end; until 1=2; end; {*********************************************** ****} procedure listeleme; var s:integer; begin assign(dosya,''Meslek.dat''); {$i-}reset(dosya);i:=ioresult;{$i+} if i<>0 then begin writeln(''!!!Dosya Yok!!!''); tus:=readkey;halt; end; clrscr; writeln(''AD MESLEK SEHIRTELEFON''); writeln(''________________________________________ ___________________________''); window(1,3,80,25); s:=0; for i:=0 to filesize(dosya)-1 do begin seek(dosya,i);read(dosya,kay); if kay.f='''' then begin s:=s+1; gotoxy(1,s);write(kay.Isim); gotoxy(17,s);write(kay.Meslek); gotoxy(39,s);write(kay.Sehir); gotoxy(60,s);write(kay.telefon); end; if s>18 then begin gotoxy(20,21); write(''Diger Sayfa I‡in Bir Tusa Basiniz...''); tus:=readkey; s:=0; clrscr; end; end; gotoxy(20,21);write(''Listelenecek Kayitlar Bitti!...''); tus:=readkey; window(1,1,80,25); close(dosya); end; {*********************************************** ****************} procedure arama; var aratring[30]; begin assign(dosya,''Meslek.dat''); {$i-}reset(dosya);kod:=ioresult;{$i+} if kod<>0 then begin gotoxy(20,20);write(''!!!Dosya Yok!!!''); tus:=readkey;exit; end; repeat clrscr; cerceve(20,3,60,5); gotoxy(22,4);write(''Aradiginiz Isim:'');readln(ara); if ara='''' then begin close(dosya);exit; end; for i:=0 to filesize(dosya)-1 do begin seek(dosya,i); read(dosya,kay); if (kay.f='''') and (kay.Isim=ara) then begin clrscr; cerceve(10,5,70,15); gotoxy(15,7);writeln(''Isim...........:'',kay.Isim ); gotoxy(15,9);writeln(''Meslek.........:'',kay.Mesl ek); gotoxy(15,11);writeln(''Sehir..........:'',kay.Seh ir); gotoxy(15,13);writeln(''Telefon........:'',kay.Tel efon); cerceve(10,16,70,18); gotoxy(25,17);write(''Aradiginiz Kayit Bu Mu? [E/H]''); repeat tus:=upcase(readkey); until tus in [''E'',''H'']; if tus=''E'' then begin close(dosya);exit; end; end; end; writeln; cerceve(10,16,70,18); gotoxy(15,17);write(''Aradiginiz Kayit Yok.Devam Etmek I‡in Bir Tusa Basiniz.''); tus:=readkey; until 1=2; end; {*********************************************** ************************} procedure Duzeltme; var aratring[30]; begin assign(dosya,''Meslek.dat''); {$i-}reset(dosya);kod:=ioresult;{$i+} if kod<>0 then begin gotoxy(20,20);write(''!!!Dosya Yok!!!....''); tus:=readkey; exit; end; clrscr; cerceve(20,3,60,5); gotoxy(22,4);write(''D�zeltilecek Isim:'');readln(ara); for i:=0 to filesize(dosya)-1 do begin seek(dosya,i);read(dosya,kay); if (ara=kay.Isim) and (kay.f='''') then begin clrscr; cerceve(10,5,70,15); gotoxy(15,7);writeln(''Isim...........:'',kay.Isim ); gotoxy(15,9);writeln(''Meslek.........:'',kay.Mesl ek); gotoxy(15,11);writeln(''Sehir..........:'',kay.Seh ir); gotoxy(15,13);writeln(''Telefon........:'',kay.Tel efon); cerceve(10,16,70,18); gotoxy(25,17);write(''Aradiginiz Kayit Bu Mu? [E/H]''); repeat tus:=upcase(readkey); until tus in [''E'',''H'']; if tus=''E'' then repeat clrscr; cerceve(10,5,70,17); gotoxy(15,7);writeln(''1-Isim...........:'',kay.Isim); gotoxy(15,9);writeln(''2-Meslek.........:'',kay.Meslek); gotoxy(15,11);writeln(''3-Sehir..........:'',kay.Sehir); gotoxy(15,13);writeln(''4-Telefon........:'',kay.Telefon); gotoxy(15,15);writeln(''5-Islem Sonu''); cerceve(10,18,70,20); gotoxy(20,19);writeln(''Se‡iminiz (1..5) (Esc=iptal):''); repeat tus:=readkey; until tus in[''1''..''5'',#27]; if tus<>#27 then cerceve(10,21,70,23); case tus of ''1'':begin gotoxy(15,22); write(''Isim..........:'');readln(kay.Isim); end; ''2'':begin gotoxy(15,22); write(''Meslek........:'');readln(kay.Meslek); end; ''3'':begin gotoxy(15,22); write(''Sehir.........:'');readln(kay.Sehir); end; ''4'':begin gotoxy(15,22); write(''Telefon.......:'');readln(kay.Telefon); end; ''5'':begin seek(dosya,i); write(dosya,kay); gotoxy(20,22); write(''Islem Tamamlandi...''); close(dosya); tus:=readkey;exit; end; #27:exit; end; until 1=2; end; end; gotoxy(20,20);write(''!!!Kay�t Yok!!!''); close(dosya); tus:=readkey; end; {*********************************************** ***********************} procedure silme; var aratring[20]; begin assign(dosya,''Meslek.dat''); {$i-}reset(dosya);kod:=ioresult;{$i+} if kod<>0 then begin gotoxy(20,20);write(''!!!Dosya Yok!!!''); tus:=readkey;exit; end; clrscr; cerceve(10,3,70,5); gotoxy(15,4);write(''Silinecek Isim:'');readln(ara); for i:=0 to filesize(dosya)-1 do begin seek(dosya,i);read(dosya,kay); if (ara=kay.Isim) and (kay.f='''') then begin clrscr; cerceve(10,5,70,15); gotoxy(15,7);writeln(''Isim...........:'',kay.Isim ); gotoxy(15,9);writeln(''Meslek.........:'',kay.Mesl ek); gotoxy(15,11);writeln(''Sehir..........:'',kay.Seh ir); gotoxy(15,13);writeln(''Telefon........:'',kay.Tel efon); cerceve(10,16,70,18); gotoxy(25,17);write(''Silinecek Kayit Bu Mu? [E/H]''); repeat tus:=upcase(readkey); until tus in [''E'',''H'']; if tus=''E'' then begin kay.f:=''s''; seek(dosya,i);write(dosya,kay); gotoxy(20,20);write(''Kayit Silindi!...''); close(dosya); tus:=readkey; exit; end; end; end; gotoxy(20,20);write(''!!!Kayit Yok!!!''); close(dosya);tus:=readkey; end; {*********************************************** *****************} procedure ekran; begin clrscr; cerceve(1,1,80,24); cerceve(3,2,78,4); cerceve(3,5,20,20); cerceve(22,5,60,7); cerceve(22,8,60,23); cerceve(62,5,78,20); cerceve(3,21,20,23); cerceve(62,21,78,23); gotoxy(27,3);write(''TELEFON TAKIP PROGRAMI''); gotoxy(27,6);write(''Design by restart_on''); end; {********************************************* ************************} begin repeat ekran; gotoxy(30,10);write(''1-Bilgi Girisi''); gotoxy(30,12);write(''2-Bilgi Listesi''); gotoxy(30,14);write(''3-Bilgi Arama''); gotoxy(30,16);write(''4-Bilgi D�zeltme''); gotoxy(30,18);write(''5-Bilgi Silme''); gotoxy(30,20);write(''Se‡iminiz (Esc=Cikis):''); repeat t:=readkey; if t=#27 then halt; until t in[''1''..''5'',#27.); case t of ''1'':Kayityap; ''2'':Listeleme; ''3'':Arama; ''4''uzeltme; ''5''[img]smileys/smiley5.gif[/img]ilme; end; until false; end. Smileylerden Dolayi Kodlari alamiyorsaniz Tiklayin Ö(lürsem)S(ebebi)S(ensin) Kristallnacht Sanmam Kurt Adam Angolosakson Rüyasi Gidin Sorun Belki De Kendisi Akinci Dölü TÜRK Oglu Türktür

31-07-08, 12:28 Çevrimdışı	#2
Öğretim üyesi askkorsani Müzik grubu Genel Mesajlar: 561 Teşekkür etti: 105 Teşekkür edildi: 128 RepForum Gücü: 8 Forum Puanı:1001 Ruhsal Durumum:	Bu ne

Konu Seçenekleri
Yazdırılabilir Sümü Göster Sayfayı E-Mail'le gönder