|
09.09.09, 22:22
| #1 (permalink) |
| мαѕαŁрєяєѕт*   Üyelik tarihi: Ağu 2009
Mesajlar: 4.686
Ettiği Teşekkür Sayısı: 690
764 Konuda 11.163 Teşekkür Aldı
  |  Pascal Telefon Ajanda Programı Uses CRT; Type Kayit=Record KAYITNOtring[8]; ADSOYADtring[20]; TELtring[10]; ADREString[100];F:Char; End; Var Dosya:File Of Kayit; Kay:Kayit; Tus:Char; T:Boolean; I,Kod,M: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 dos; var sifTring; begin clrscr; Cerceve(10,5,70,20);gotoxy(12,9);Writeln('Dosyay� Yeniden Olusturursan�z Kay�tlar Silinecek[ENTER] '); gotoxy(12,12); WRite('Sifreyi Girin...:');Readln(sif); IF Sif='123456' Then begin assign(dosya,'AJANDA.dat'); rewrite(dosya); close(dosya); Gotoxy(12,15); WRite('S�fre Dogru Dosyan�z Yeniden Olusturuldu.'); tus:=readkey; exit; end; gotoxy(12,15);WRite('Sifre Yanl�s'); tus:=readkey; end; Procedure KAYITYAP; Begin Assign(Dosya,'AJANDA.Dat'); Reset(Dosya); Repeat Clrscr; Cerceve(10,5,70,20); Gotoxy(15,7);Write('SIRA NO...:');Readln(Kay.KAYITNO); If Kay.KAYITNO='' Then Begin Close(Dosya);Exit; End; Gotoxy(15,9);Write('ADI/SOYADI....:');Readln(Kay.A DSOYAD); Gotoxy(15,11);Write('TELEFON NUM......:');Readln(Kay.TEL); Gotoxy(15,13);Write('ADRES......:');Readln(Kay.ADR ES); Cerceve(10,21,70,23);Gotoxy(11,22); write('Bilgi Dosyaya yaz�ls�n m�? [E/H] '); Repeat Tus:=Upcase(Readkey); Until Tus In ['E','H',#27]; If Tus='E' Then Begin Kay.F:='*'; Seek(Dosya,Filesize(Dosya)); Write(Dosya,Kay); Close(Dosya); End Else Tus:=Readkey;Exit; Until 1=2; End; Procedure LISTELEME; VAR S:Integer; Begin Assign(Dosya,'AJANDA.Dat'); Reset(Dosya); Clrscr; S:=2; For I:=0 To Filesize(Dosya)-1 Do Begin Seek(Dosya,I);Read(Dosya,Kay); If Kay.F='*' Then Begin gotoxy(1,1);Writeln('SIRANO ADI/SOYADI TELEFON NUM ADRES'); gotoxy(1,2);Writeln('------ ----------- ------------- ------------------------------------------'); S:=S+1; Gotoxy(2,S);Write(Kay.KAYITNO); Gotoxy(10,S);Write(Kay.ADSOYAD); Gotoxy(23,S);Write(Kay.TEL); Gotoxy(40,S);Write(Kay.ADRES); End; If S>18 Then Begin Gotoxy(20,21); Write('Diger sayfa i‡in bir tusa bas�n�z...'); Tus:=Readkey; S:=1; Clrscr; End; End; Gotoxy(20,21);Write('Listelenecek Kayitlar bitti...'); Tus:=Readkey; Close(Dosya); End; Procedure YAZ; var kalan,kod,mik,cikmik,KAYITNO:Word; z,i:Word; cev:Char; Begin Assign(Dosya,'AJANDA.Dat'); Reset(Dosya); Clrscr; Cerceve(5,3,75,18); Gotoxy(10,5);Write('SIRA NO......:');Readln(KAYITNO); For i:=0 to Filesize(Dosya)-1 Do Begin Seek(Dosya,i); Read(Dosya,kay); val(Kay.KAYITNO,Kod,Z); if (KAYITNO=Kod) And (Kay.F='*') then begin Gotoxy(10,7);Write('ADI/SOYADI.......:',Kay.ADSOYA D); Gotoxy(10,9);Write('TELEFON NUM.........:',Kay.TEL); Gotoxy(10,11);Write('ADRES........:',Kay.ADRES); Gotoxy(10,17);writeln('Aranilan kayit bu mu?');gotoxy(31,17);cev:=upcase(readkey); if cev='E' Then Begin Val(Kay.ADRES,mik,z); Kalan:=mik-cikmik; Gotoxy(10,21);write('ADRES=',kalan); Str(kalan,kay.ADRES); Seek(dosya,i); Write(dosya,kay);readkey;close(dosya);exit; End; End; End; If Cev<>'E' Then Begin Gotoxy(10,21);Write('Kay�t Yok');End; Close(Dosya); readkey; End; Procedure DUZELTME; VAR ARAtring[30]; Begin Assign(Dosya,'AJANDA.Dat'); Reset(Dosya); Clrscr; Cerceve(20,3,60,5); Gotoxy(22,4);Write('D�zeltilecek SIRA NO..:');Readln(ARA); For I:=0 To Filesize(Dosya)-1 Do Begin Seek(Dosya,I);Read(Dosya,Kay); If (ARA=Kay.KAYITNO) And (Kay.F='*') Then Begin Clrscr; Cerceve(10,5,70,19); Gotoxy(15,7);Writeln('SIRANO......:',Kay.KAYITNO); Gotoxy(15,9);Writeln('ADI/SOYADI.......:',Kay.ADSO YAD); Gotoxy(15,11);Writeln('TELEFON NUM.........:',Kay.TEL); Gotoxy(15,13);Writeln('ADRES........:',Kay.ADRES); Cerceve(10,20,70,22); Gotoxy(20,21);Write('D�zeltilecek Kay�t bu mu? [E/H] '); Repeat Tus:=Upcase(Readkey); Until Tus In['E','H']; If Tus='E' Then Repeat Clrscr; Cerceve(10,3,70,19); Gotoxy(15,5);Writeln('1-SIRANO.....:',Kay.KAYITNO); Gotoxy(15,7);Writeln('2-ADI/SOYADI......:',Kay.ADSOYAD); Gotoxy(15,9);Writeln('3-TELEFON NUM........:',Kay.TEL); Gotoxy(15,11);Writeln('4-ADRES.......:',Kay.ADRES); Gotoxy(15,17);Writeln('7-Islemi Tamamla...'); Cerceve(10,20,70,22); Gotoxy(20,21); Write('Se‡iminiz (1..7) ( ESC=iPTAL ) ...:'); Repeat Tus:=Readkey; Until Tus In['1'..'7',#27]; If Tus<>#27 Then Cerceve(10,23,70,25); Case Tus Of '1' :Begin Gotoxy(15,24); Write('SIRANO...:');Read(Kay.KAYITNO); End; '2' :Begin Gotoxy(15,24); Write('ADI/SOYADI...:');Read(Kay.ADSOYAD); End; '3' :Begin Gotoxy(15,24); Write('TELEFON NUM...:');Readln(Kay.TEL); End; '4' :Begin Gotoxy(15,24); Write('ADRES...:');Read(Kay.ADRES); 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[30]; Begin Assign(Dosya,'AJANDA.Dat'); Reset(Dosya); Clrscr; Cerceve(10,3,70,5); Gotoxy(15,4);Write('Silinecek TEL NO Kodu...:');Readln(ARA); For I:=0 To Filesize(Dosya)-1 Do Begin Seek(Dosya,I);Read(Dosya,Kay); If (ARA=Kay.KAYITNO) And (Kay.F='*') Then Begin Clrscr; Cerceve(10,3,70,17); Gotoxy(15,5);Writeln('SIRANO ........:',Kay.KAYITNO); Gotoxy(15,7);Writeln('ADI/SOYADI .........:',Kay.ADSOYAD); Gotoxy(15,9);Writeln('TELEFON NUM ...........:',Kay.TEL); Gotoxy(15,11);Writeln('ADRES ..........:',Kay.ADRES); Cerceve(10,18,70,20);Gotoxy(25,19); 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(25,22);Write('Kayit silindi....'); Close(Dosya); Tus:=Readkey; Exit; End; End; End; Gotoxy(20,20);Write('Kayit yok...'); Close(Dosya); Tus:=Readkey; End; Procedure ILK_EKRAN; var a,c:string; b,i:integer; Begin Clrscr; Cerceve(1,1,80,24); Cerceve(3,2,78,4);gotoxy(31,6);write('AJANDA PROGRAMI V.S.1.0'); textcolor(4);gotoxy(5,8);write('Adana/Y�re§ir'); textcolor(4);gotoxy(5,10);write('i.m.k.b'); textcolor(4);gotoxy(4,12);write('end�stri.mes.lis' ); textcolor(4);gotoxy(6,14);write('BILGISAYAR '); textcolor(4);gotoxy(8,16);write('B™LšMš'); textcolor(4);gotoxy(63,8);write('Hidayet Y�lmaz'); textcolor(4);gotoxy(63,10);write('T�rker Erdevir'); textcolor(4);gotoxy(63,12);write('Veli �amaral'); textcolor(4);gotoxy(64,14);write('Musa'); textcolor(1); 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); textcolor(19);highvideo; gotoxy(32,3);write('TEL AJANDA PROGRAMI'); End; Begin M:=0; textcolor(15);highvideo; textbackground(8); clrscr; Repeat ILK_EKRAN; textcolor(4);Gotoxy(30,9);Write('0_DOSYA OLUSTUR '); textcolor(4);Gotoxy(30,11);Write('1- K˜�˜ BILGI GIRISI '); textcolor(4);Gotoxy(30,13);Write('2- K˜�˜ LISTESI '); textcolor(4);Gotoxy(30,15);Write('3- K˜�˜ DšZELTME '); textcolor(4);Gotoxy(30,17);Write('4- K˜�˜ SIL '); textcolor(14);Gotoxy(30,24);Write('[5]-CIKIS--[ESC]-CIKIS'); textcolor(4);Gotoxy(28,21);Write(' SECIMINIZ [1..5]...:'); Repeat Tus:=Readkey; Until Tus In ['0'..'6',#27]; Case Tus Of '0' :dos; '1' :KAYITYAP; '2' :LISTELEME; '3' UZELTME; '4' :SILME; '5' :Begin Clrscr;Halt;End; #27 :Begin Clrscr;Halt;End; End; Until 1=2; End.
__________________ Allah bir'di, s e n iki ! |
|  |
adresine bildirebilirsiniz, şikayetiniz incelenip en kısa sürede gereken yapılır.
Normal
