Pascal Telefon Ajanda Programı

'Programlama' forumunda sha. tarafından 9 Eyl 2009 tarihinde açılan konu

Konu etiketleri:
  1. sha.

    sha. ..daha çirkin, daha huysuz

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

Bu Sayfayı Paylaş