Programalama > PASCAL

Etiketler: çok, islemli, bir, program

Ort. 3
Puan ver:
Program NUFUS;
          Uses CRT,DOS;
          Type
            datetimetype=string[8];
            string79=string[30];

            (*********** KAYIT DEGISKENLERI **************)

            Kimlik=Record
                   seri           : string[10]   ;
                   no             : string[10]   ;
                   soyadi         : string[13]  ;
                   adi            : string[13]  ;
                   baba_adi       : string[13]  ;
                   ana_adi        : string[13]  ;

                   d              : char        ;
          End;

          Const
                   bell=7               ;
                   back_space=8         ;
                   carriage_return=13   ;
                   escape=27            ;
                   right_arrow=77       ;

          Var
                   seri1         : string79  ;
                   no1           : string79  ;
                   soyadi1       : string79  ;
                   adi1          : string79  ;
                   rh1           : string79  ;
                   il1           : string79  ;

                   ara_adi1           : string79;
                   ara_soyadi1        : string79;
                   ara_baba_adi1      : string79;
                   ara_ana_adi1       : string79;
                   ara_cilt_no1       : string79;
                   ara_no1            :string79;
                   ara_soyaddi1        :string79;
                   ara_seri1          :string79;
                   ara_addi1           :string79;
                   ara_aile_sira_no1  : string79;
                   kod1               : string79;

          Var
                   kayit : kimlik;
                   dosya : file of kimlik;
                   cevap : char;
                   devam : char;
                   tus   : char;
                   i     : integer;
                   j     : integer;
                   kod2  : integer;
                   ara_adi          : string[13];
                   ara_soyadi       : string[13];
                   ara_baba_adi     : string[13];
                   ara_ana_adi      : string[13];
                   saat             : datetimetype;


          (************* EKRANA SAAT MESAJI ***************)

          Function time :datetimetype;
               var
               reg:registers;
               h,m,s,w:datetimetype;

               begin
               reg.ax:=$2c00;
               intr($21,reg);
               str(hi(reg.cx):2,h);
               str(lo(reg.cx):2,m);
               str(hi(reg.dx):2,s);
               w:=h + ':' + m ;
               for i:=i to length(w) do if w[i]=' ' then w[i]:='0';
               time:=w;
               end;

          (***********************************************)

          Procedure Set_video(attribute:integer);
          Var
           blinking,bold:integer;
          Begin
           blinking:=(attribute and 4)*4;
            if (attribute and 12)=11 then
              begin
               bold:=(attribute and 2)*7;
               Textcolor(1+blinking+bold);
               Textbackground(0);
              end
              else
               begin
                bold:=(attribute and 2)*5 div 2;
                Textcolor(14+blinking);
                Textbackground(0);
               end;
          End;

          (************************************************)

          Procedure put_string(out_string:string79;line,col,attrib:integer);
          Begin
           set_video(attrib);
           gotoxy(col,line);
           write(out_string);
           set_video(1);
          End;

          (************************************************)

          Procedure Get_string(var in_string:string79;
                                    line,col,attrib,str_length:integer);
          Var
            oldstr  : string79 ;
            in_char : char     ;
            i       : integer  ;
          Begin
            oldstr:=in_string;
            put_string(in_string,line,col,attrib);
              for i:= length(in_string) to str_length-1 do
               put_string(' ',line,col+i,attrib);
               gotoxy(col,line);
               in_char:=readkey;
                 if ord(in_char)<>carriage_return then
                   in_string:='';
                     while ord(in_char)<>carriage_return do
                      begin
                       if ord(in_char)=back_space then
                          begin
                            if length(in_string)>0 then
                              begin
                                in_string[0]:=chr(length(in_string)-1);
                                write(chr(back_space));
                                write(' ');
                                write(chr(back_space));
                              end;
                          end
                          else
                            if ord(in_char)=escape then
                             begin
                              in_char:=readkey;
                               if ord(in_char)=right_arrow then
                                 begin
                                  if length(oldstr)>length(in_string) then
                                    begin
                                     in_string[0]:=chr(length(in_string)+1);
                                     in_char:=oldstr[ord(in_string[0])];
                                     in_string[ ord(in_string[0])]:=in_char;
                                     write(in_char);
                                    end;
                                 end
                                  else
                                   write(chr(bell));
                             end
                              else
                                if length(in_string)<str_length then
                                  begin
                                   in_string[ 0]:=chr(length(in_string)+1);
                                   in_string[ord(in_string[0])]:=in_char;
                                   write(in_char);
            end
              else
                  write(chr(bell));
                  in_char:=readkey;
            end;
              put_string(in_string,line,col,attrib);
              for i:= length(in_string)to str_length-1 do
              put_string(' ',line,col+i,0);

          End;


          (**************** KIMLIK EKRANI *****************)

          Procedure Kimlik_menu;
          Begin
            Clrscr;
            TEXTCOLOR(RED);
            GOTOXY(10,1);      write('ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»');
            GOTOXY(10,2);      write('º                 <<<KAYIT GIRIS   MEN&#353;S&#353;>>>                 º');
            GOTOXY(10,3);      write('º                                                            º');
            GOTOXY(10,4);      write('ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹');
            GOTOXY(10,5);      write('º  URUN  ADI      º                                          º');
            GOTOXY(10,6);      write('º                 º                                          º');
            GOTOXY(10,7);      Write('ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹                                          º');
            GOTOXY(10,8);      write('º  URUN  NO       º                                          º');
            GOTOXY(10,9);      write('º                 º                                          º');
            GOTOXY(10,10);     write('ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹                                          º');
            GOTOXY(10,11);     write('º  URUN  CINSI    º                                          º');
            GOTOXY(10,12);     write('º                 º                                          º');
            GOTOXY(10,13);     write('ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹                                          º');
            GOTOXY(10,14);     write('º  URUN TARIHI    º                                          º');
            GOTOXY(10,15);     write('º                 º                                          º');
            GOTOXY(10,16);     write('ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹                                          º');
            GOTOXY(10,17);     write('ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ');

          End;

          (************** KURSOR AKTIF-PASIF **************)

          Procedure kursor(m:boolean);
          Var
           r:registers;
          Begin
           case m of
            true:  begin
                    r.ch:=0 ;
                    r.cl:=14;
                   end;
            false: begin
                    r.ch:=31;
                    r.cl:=0 ;
                   end;
           end;
            r.ah:=1;
            r.al:=0;
            intr($10,r);
          End;


          (***************** ZEMIN RENGI ******************)

          Procedure  zeminrengi(t:byte);
          Begin
           Textbackground(t);
           for i:=1 to 25 do Write('':10);
          End;

          (*************** PENCERE ICI RENGI **************)

          Procedure prengi(renk:byte);
          Begin
            Textbackground(renk);
            for j:=3 to 23 do Write(' ':78);
          End;

          (******************* CERCEVE ********************)

          Procedure Cerceve(x1,y1,x2,y2:byte);
          Var
            k:byte;
          Begin
            Gotoxy(x1,y1);Write(#201);
            for k:=x1+1 to x2-1 do Write (#205);
             Write(#187);
             for k:= y1+1 to y2-1 do
               begin
                 Gotoxy(x1,k);Write(#186);
                 Gotoxy(x2,k);Write(#186);
               end;
                 Gotoxy(x1,y2);Write(#200);
                   for k:=x1+1 to x2-1 do Write(#205);
                   Write(#188);
          End;

          (************* CIKISTA EKRANA MESAJ *************)

          Procedure Cikis_menu;
          Begin
            clrscr;
            Textcolor(0);
            Cerceve(1,1,80,24);
            Textcolor(0);
            delay(50);Gotoxy(3,8);Writeln('U');
            delay(150);Gotoxy(4,8);Writeln('R');
            delay(50);Gotoxy(5,8);Writeln('U');
            delay(150);Gotoxy(6,8);Writeln('N');
            delay(50);Gotoxy(7,8);Writeln(' ');
            delay(150);Gotoxy(8,8);Writeln('K');
            delay(50);Gotoxy(9,8);Writeln('A');
            delay(150);Gotoxy(10,8);Writeln('Y');
            delay(50);Gotoxy(11,8);Writeln('I');
            delay(150);Gotoxy(12,8);Writeln('T');
            delay(50);Gotoxy(13,8);Writeln(' ');
            delay(150);Gotoxy(14,8);Writeln('G');
            delay(50);Gotoxy(15,8);Writeln('I');
            delay(150);Gotoxy(16,8);Writeln('R');
            delay(50);Gotoxy(17,8);Writeln('I');
            delay(150);Gotoxy(18,8);Writeln('S');
            delay(50);Gotoxy(19,8);Writeln(' ');
            delay(150);Gotoxy(20,8);Writeln('P');
            delay(50);Gotoxy(21,8);Writeln('R');
            delay(50);Gotoxy(22,8);Writeln('O');
            delay(150);Gotoxy(23,8);Writeln('G');
            delay(50);Gotoxy(24,8);Writeln('R');
            delay(150);Gotoxy(25,8);Writeln('A');
            delay(50);Gotoxy(26,8);Writeln('M');
            delay(150);Gotoxy(27,8);Writeln('I');

            DELAY(150);Gotoxy(3,9);Writeln('V');
            DELAY(50);Gotoxy(4,9);Writeln('E');
            DELAY(50);Gotoxy(5,9);Writeln('R');
            DELAY(50);Gotoxy(6,9);Writeln('S');
            DELAY(50);Gotoxy(7,9);Writeln('I');
            DELAY(50);Gotoxy(8,9);Writeln('Y');
            DELAY(150);Gotoxy(9,9);Writeln('O');
            DELAY(150);Gotoxy(10,9);Writeln('N');
            DELAY(50);Gotoxy(11,9);Writeln(' ');
            DELAY(50);Gotoxy(12,9);Writeln('1');
            DELAY(50);Gotoxy(13,9);Writeln('.');
            DELAY(150);Gotoxy(14,9);Writeln('0');
            Gotoxy(3,10);Writeln('COPYRIGTH MUHTEREM PISIL');
            Textcolor(red);

            Gotoxy(13,21); Writeln('NIGDE TEKNIK LISE ve ANADOLU MESLEK LISESI BILGISAYAR BOLUMU..');
            Gotoxy(1,25) ;
            Kursor(false);
           readln;
          End;

          (***************** ANA CERCEVE ******************)

          Procedure Ana_cerceve;
          Const
            gunler:Array [0..6] of string[8]=('Pazar','P.tesi','Sali',
                                     'Carsamba','Persembe','Cuma','C.tesi');
          Var
            yil,ay,gun,gn:word;
          Begin
            clrscr;
            Textcolor(4);
            cerceve(1,1,80,24);
            Textcolor(1); Textbackground(15);
            for i:=2 to 79 do
             begin
              Gotoxy(i,2); Writeln(' ':1);
              Gotoxy(i,23);Writeln(' ':1);
             end;
              Textcolor(1);
              Gotoxy(2,2);Write('URUN KAYIT PROGRAMI 1.00 2004-2005 ');
              Textcolor(0);
              Textbackground(2);
              getdate(yil,ay,gun,gn);
              Textcolor(0);
              Textbackground(2);
              getdate(yil,ay,gun,gn);
              Gotoxy(60,2);Write(gun:0,'/',ay:0,'/',yil:0,' ',Gunler[gn]);

              i:=0;
              saat:=time;
              Gotoxy(50,2);Write(saat);
              Textcolor(128+0);Gotoxy(52,2);Write(':');
          End;

          (************* GIRISTEN KAYIT OKUMA *************)

          Procedure Kayit_oku;
          Begin
           kursor(true);
           Textcolor(5);
           Textbackground(1);
              get_string(seri1,6,40,10,10);
              kayit.seri:=seri1;
              get_string(no1,9,40,10,10);
              kayit.no:=no1;
              get_string(soyadi1,12,40,10,10);
              kayit.soyadi:=soyadi1;
              get_string(adi1,15,40,10,10);
              kayit.adi:=adi1;


          End;

          (************** EKRANA KAYIT YAZMA **************)

          Procedure Kayit_yaz;
           Begin
            Textcolor(2);

            Gotoxy(35,6)  ;      Write(kayit.seri)         ;
            Gotoxy(35,9)  ;      Write(kayit.no)           ;
            Gotoxy(35,12)  ;      Write(kayit.soyadi)       ;
            Gotoxy(35,15)  ;      Write(kayit.adi)          ;
End;

          (***************** EVET HAYIR *******************)

          Procedure Evethayir(i,j,k,l:byte);
          Begin
             Textcolor(14);  Gotoxy(i,j)  ; Write('E')    ;
             Textcolor(5) ;  Gotoxy(i+1,j); Write('VET ') ;
             Textcolor(14);  Gotoxy(k,l)  ; Write('H')    ;
             Textcolor(5) ;  Gotoxy(k+1,l); Write('AYIR') ;
          End;

          (****************  ALAN BOSALTMA ****************)

          Procedure alan_bosalt;
          Begin
            seri1         := '  ' ;     kayit.seri         := seri1         ;
            no1           := '  ' ;     kayit.no           := no1           ;
            soyadi1       := '  ' ;     kayit.soyadi       := soyadi1       ;
            adi1          := '  ' ;     kayit.adi          := adi1          ;

          End;

          (********************* GIRIS ********************)

          Procedure Giris;
          Begin
           Repeat
            Textcolor(4);  Textbackground(7);
            Gotoxy(4,23);  Write('URUN KAYIT GIRIS PROGRAMI ','                                    VERSIYON 1.0');
            Window(2,3,79,22);
            Prengi(1);
            Alan_bosalt   ;
            Kimlik_menu   ;
            Kayit_oku     ;
            Textcolor(14) ; Textbackground(1);
            Gotoxy(25,19) ; Writeln('GIRILEN KAYIT DOGRU MU?');
            Evethayir(49,19,54,19);
             Repeat
              Kursor(false);
              Cevap := Upcase(Readkey);
             Until Cevap in ['E','H'];
               If Cevap='E' Then
                 Begin
                  kayit.d:='*';
                  Seek  (Dosya,Filesize(dosya));
	          Write (Dosya,Kayit);
                   Repeat
                    Textcolor(14);
                    Gotoxy(30,18); Write('GIRIS ISLEMI TAMAMLANDI...');
                    Textcolor(128+15);
                    Gotoxy(20,19);
                    Write('ANA MENUYE DONMEK ICIN <<Esc>> TUSUNA BASINIZ...');
                    Tus:=readkey;
                   Until tus in [#27];
                    Window(1,1,80,25);
                    Exit;
               End;{if}
                    Textcolor(14);
                    Gotoxy(23,19); Write('KAYDI YENIDEN GIRECEK MISINIZ?');
                    Evethayir(54,19,59,19);
                      Repeat
  	               Devam := Upcase(Readkey);
                      Until Devam in ['E','H'];
           Until Devam in ['H'];
                   Textcolor(128+15);
                   Gotoxy(18,19);
                   Write('ANA MENUYE DONMEK ICIN <<Esc>> TUSUNA BASINIZ...');
                      Repeat
                       Tus:=Readkey;
                      Until tus=#27;
             Window(1,1,80,25);
             Exit;
          End; {ana}

          (********************* ARAMA ********************)

          Procedure Arama;
          Begin
           Repeat
            Kursor(true);
            Textcolor(4); Textbackground(7);
            Gotoxy(3,23); Write('URUN KAYIT ARAMA');
            Window(2,3,79,22);
            Prengi(1);
            Kimlik_menu;
            Textcolor(YELLOW);
            Gotoxy(23,2); Write('  <<< URUN KAYIT ARAMA MEN&#353;S&#353; >>>');
            Textcolor(15);
            ara_seri1    :=' ';
            Get_string(ara_seri1,5,39,0,13)    ;ara_seri1   :=ara_seri1  ;
            For i:=0 to filesize(dosya)-1 do
             Begin
              Seek (dosya,i);
              Read (dosya,kayit);
               If (kayit.d='*') and (kayit.seri=ara_seri1)

                                then
                Begin
                 Prengi(1);
                 Kimlik_menu;
                 Kayit_yaz;
                 Textcolor(14);
                 Gotoxy(24,19); Write('ARADIGINIZ KAYIT BU MU?');
                 Evethayir(49,19,54,19);
                  Repeat
                   Kursor(false);
                   Cevap :=Upcase(Readkey);
                   Until Cevap in ['E','H'];
                   If Cevap='E' then begin
                    Repeat
                    Textcolor(14);
                    Gotoxy(30,18); Write('ARAMA ISLEMI TAMAMLANDI...');
                    Textcolor(128+15);
                    Gotoxy(20,19);
                    Write('ANA MENUYE DONMEK ICIN <<Esc>> TUSUNA BASINIZ...');
                    Tus:=Readkey;
                    Until Tus=#27;
                     Window(1,1,80,25);
                     Exit;
                   end;{if}
                end;{if}
            end;{for}
                   Prengi(1);
                   Textcolor(10);
                   Cerceve(20,10,60,14);
                   Gotoxy(22,12);
                   Write('DOSYADA BOYLE BIR KAYIT MEVCUT DEGIL!');
                   Textcolor(14);
                   Gotoxy(13,19);
                   Write('ARAMA ISLEMINI TEKRAR DENEYECEK MISINIZ?');
                   Evethayir(54,19,59,19);
                    Repeat
                     Kursor(false);
                     Devam:= Upcase(Readkey);
                    Until Devam in ['E','H'];
           Until Devam in ['H'];
                    Gotoxy(12,19);Clreol;
                    Gotoxy(17,19);
                    Textcolor(128+15);
                    Write('ANA MENUYE DONMEK ICIN <<Esc>> TUSUNA BASINIZ...');
                     Repeat
                      Tus:=Readkey;
                     Until Tus=#27;
                      Window(1,1,80,25);
                      Exit;
          End;{ana}

          (**************** DUZELTME MENUSU ***************)

          Procedure Duzeltme_menusu;
          Begin
            Assign(Dosya,'C:\Kimlik.dat');
            {$I-}
            Reset(dosya);
            {$I+}
            If ioresult <> 0 then Rewrite(dosya);
            Textcolor(YELLOW);
            Textbackground(1);

            Gotoxy(60,5)   ;      Writeln('=> 1 <=')   ;
            Gotoxy(60,8)   ;      Writeln('=> 2 <=')   ;
            Gotoxy(60,11)   ;      Writeln('=> 3 <=')   ;
            Gotoxy(60,14)  ;      Writeln('=> 4 <=')   ;


            Textcolor(14);
            Gotoxy(21,19) ; Write('DUZELTILECEK BILGININ KODUNU GIR :[  ]');

           Repeat
             Kursor(true);
             kod1:=' ';
             Get_string(kod1,19,56,1,2);
             Val(kod1,kod2,i);
               Case kod2 of

                      1: begin
                          seri1:=' ';
                          Get_string(seri1,6,40,10,10);
                          kayit.seri:=seri1;

                         end;
                      2:begin
                      no1:=' ';
                          Get_string(no1,9,40,10,10);
                          kayit.no:=no1;
                      end;
                      3: begin
                          soyadi1:=' ';
                          Get_string(soyadi1,12,40,10,10);
                          kayit.soyadi:=soyadi1;
                         end;
                      4: begin
                          adi1:=' ';
                          Get_string(adi1,15,40,10,10);
                          kayit.adi:=adi1;
                         end;

      end;
         Until kod2 in[1,2,3,4];
          End;

          (******************* DUZELTME *******************)

          Procedure Duzeltme;
          Begin

           Repeat

            Kursor(true);
            Textcolor(4)        ;
            Textbackground(7)   ;
            Gotoxy(3,23)        ;
            Write('URUN KAYIT D&#353;ZELTME');
            Window(2,3,79,22)   ;
            Prengi(1)           ;
            kimlik_menu;
            TEXTCOLOR(YELLOW);
            gotoxy(26,2);write('<<< &#353;R&#353;N D&#353;ZELTME MEN&#353;S&#353; >>>');
            Textcolor(15);

            ara_seri1 := '' ;

            Get_string (ara_seri1,6,39,0,13)   ;ara_seri1   :=ara_seri1  ;

             For i:=0 to filesize(dosya)-1 do
               Begin
                 Seek (dosya,i)      ;
                 Read (dosya,kayit)  ;

                  If (kayit.d='*') and  (kayit.seri=ara_seri1)
                                   then
                   begin
                    Prengi(1)    ;
                    Kimlik_menu  ;
                    Kayit_yaz    ;
                    Textcolor(14);
                    Gotoxy(21,19); Write('DUZELTILECEK KAYIT BU MU?');
                    Evethayir(47,19,52,19);
                     Repeat
                      Kursor(false);
                      Cevap:= Upcase(Readkey) ;
                     until Cevap in ['E','H'] ;
                      If Cevap='E' then begin
                        Repeat
                         Duzeltme_menusu;
                         Kursor(false);
                         Seek   (dosya,i)      ;
                         Write  (dosya,kayit)  ;
                         Textcolor(14);
                         Textbackground(1);
                         Gotoxy(21,19);
                         Write('DUZELTILECEK BASKA BILGI VAR MI?');
                         Evethayir(54,19,59,19);
                          Repeat
                            Devam:= Upcase(Readkey);
                          Until Devam in ['E','H'];
                             if Devam='E' then Gotoxy(21,19); Clreol;
                             if Devam='H' then Gotoxy(21,19); Clreol;
                          Until Devam in ['H'];

                   Repeat
                    Textcolor(14);
                    Gotoxy(27,18);
                    Write('DUZELTME ISLEMI TAMAMLANDI...');
                    Textcolor(128+15);
                    Gotoxy(24,19);
                    Write('ANA MENUYE DONMEK ICIN <<Esc>> TUSUNA BASINIZ...');
                    Tus:= Readkey;
                   Until Tus=#27;
                    Window(1,1,80,25)  ;
                    Exit ;
                end;
             end;
          end;{for}

                   Prengi(1);
                   Textcolor(10);
                   Cerceve(20,10,60,14);
                   Gotoxy(22,12);
                   Write('BOYLE BIR KAYIT DOSYADA MEVCUT DEGIL!');
                   Textcolor(14);
                   Gotoxy(15,19);
                   Write('DUZELTME ISLEMINI TEKRAR DENEYECEK MISINIZ?');
                   Evethayir(59,19,64,19);
                    Repeat
                     Kursor(false);
                     Devam:= Upcase(Readkey);
                    Until Devam in ['E','H'];

           Until devam in ['H'];
                   Gotoxy(15,19);Clreol;
                   Textcolor(128+15);
                   Gotoxy(17,19);
                   Write('ANA MENUYE DONMEK ICIN <<Esc>> TUSUNA BASINIZ...');
                    Repeat
                     Tus:=readkey;
                    Until tus=#27;
                     Window(1,1,80,25);
                     Exit;
          End;{ana}

         (****************** LISTELEME *******************)

         Procedure Listeleme;
         Var
           s:integer;

         Begin
           Textcolor(4)      ;
           Textbackground(7) ;
           Gotoxy(3,23); Write('URUN KAYIT LISTELEME');
           Window(2,3,79,22);
           Prengi(1);
           s:=5;
            For i:=0 to  filesize(dosya)-1 do
              Begin
               Seek (dosya,i);
               Read (dosya,kayit);
                If (kayit.d='*') then
                  begin
          Textcolor(15);
          Gotoxy(6,2);
          Write('ÉÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»');
  Gotoxy(6,3);
          Write('º URUN ADI    º  URUN NO    º  URUN CINSI º  URUN TARIHI º');
          Gotoxy(6,4);
          Write('ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍÍÍÍ͹');
          Gotoxy(6,s);

          Write( kayit.SERI:10, kayit.NO:13,  kayit.SOYADI:19,kayit.adi:15);
          gotoxy(6,s);write('º');
          gotoxy(20,s);write('º');
          gotoxy(34,s);write('º');
          gotoxy(48,s);write('º');
          gotoxy(63,s);write('º');

                   s:=s+1;
                    If s>=16 then
                      begin
                       Gotoxy(20,18);
                       Textcolor(14);
                       Write('DIGER SAYFA ICIN <<ENTER>> TUSUNA BASINIZ...');
                        Repeat
                         Kursor(false);
                         Tus:= Readkey;
                        Until tus=#13;
                prengi(1);
                s:=5;
                Gotoxy(10,18);Clreol;
              end; {if}
             end; {if}
          end;{for}
          Gotoxy(6,s);
          Write('ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÍÍÍͼ');
           Kursor(false);
           Textcolor(14);
           Gotoxy(30,18); Write('LISTELENECEK KAYITLAR BITTI...');
           Textcolor(128+15);
           Gotoxy(20,19);
           Write('ANA MENUYE DONMEK ICIN <<Esc>> TUSUNA BASINIZ...');
            Repeat
             Tus:= Readkey;
            Until Tus=#27;
           Window(1,1,80,25);
           Exit;

          End;{ana}

          (********************* SILME *********************)

          Procedure Silme;

          Begin
           Repeat
            Kursor(true);
            Textcolor(4)      ;
            Textbackground(7) ;
            Gotoxy(3,23);
            Write('URUN KAYIT SILME');
            Window(2,3,79,22);
            Prengi(1);
            kimlik_menu;
            Textcolor(15);
            ara_SERI1   :=' ';

           Get_string (ara_seri1,6,40,0,10)   ;ara_seri1  :=ara_seri1  ;

           For i:=0 to filesize(dosya)-1 do
             Begin
              Seek (dosya,i);
              Read (dosya,kayit);
               If (kayit.d='*') and (kayit.seri=ara_seri1)
                                    then
                 begin
                   Prengi(1);
                   Kimlik_menu;
                   Kayit_yaz;
                   Textcolor(14);
                   Gotoxy(23,19); Write('SILINECEK KAYIT BU MU?');
                   Evethayir(46,19,51,19);
                    Repeat
                     Kursor(false);
                     Cevap:= Upcase(Readkey);
                    Until Cevap in ['E','H'];
                     If Cevap='E' then
                      begin
                       Clreol;
                       kayit.d:='s';
                       Seek  (dosya,i);
                       Write (dosya,kayit);
                        Repeat
                         Textcolor(14);
                         Gotoxy(28,18); Writeln('SILME ISLEMI TAMAMLANDI...');
                         Textcolor(128+15);
                         Textcolor(128+15);
                         Gotoxy(20,19);
                   Write('ANA MENUYE DONMEK ICIN <<Esc>> TUSUNA BASINIZ...');
                         Tus:=readkey;
                        Until Tus=#27;
                         Window(1,1,80,25);
                         Exit ;
                      end;
                 end;
             end;{for}
                 Prengi(1);
                 Textcolor(10);
                 Cerceve(20,10,60,14);
                 Gotoxy(22,12);
                 Write('BOYLE BIR KAYIT DOSYADA MEVCUT DEGIL!');
                 Textcolor(14);
                 Gotoxy(15,19);
                 Write('SILME ISLEMINI TEKRAR DENEYECEK MISINIZ?');
                 Evethayir(56,19,61,19);
                  Repeat
                   Kursor(false);
                   Devam:= Upcase(Readkey);
                  Until Devam in ['E','H'];

          Until Devam in ['H'];
                Textcolor(128+15);
                Gotoxy(12,19);clreol;
                Gotoxy(17,19);
                Write('ANA MENUYE DONMEK ICIN <<Esc>> TUSUNA BASINIZ...');
                 Repeat
                  Kursor(false);
                  Tus:= Readkey;
                 Until tus=#27;
                  Window(1,1,80,25);
                  Exit;
          End;{ana}

          (************** MENU CERCEVE CIZIMI *************)
          Procedure Cer_ciz(renk:integer);
          Begin
           For i:=2 to 79 do begin
           For j:=3  to 22 do begin
            Textcolor(1);
            Gotoxy(i,j);Write(chr(219));
           end;
           end;

           For i:=30 to 50 do begin
           For j:=8 to 17 do begin
            Textcolor(0);
            Gotoxy(i+2,j+1);Write(chr(219));
            Textbackground(renk);Gotoxy(i,j);Write(' ');
           end;
           end;
            Textcolor(14);
           For i:=31 to 49 do
            begin
             Gotoxy(i,8);Write(chr(205));
             Gotoxy(i,17);Write(chr(205));
            end;
           For j:=8 to 17 do
            begin
             Gotoxy(31,j);Write(chr(186));
             Gotoxy(49,j);Write(chr(186));
            end;
             Gotoxy(31,8)  ;  Write(chr(201));
             Gotoxy(49,8)  ;  Write(chr(187));
             Gotoxy(31,17) ;  Write(chr(200));
             Gotoxy(49,17) ;  Write(chr(188));
          End;

          (**************** MENU YAZIMI *******************)

          Procedure Menu_yaz(k:integer);
          Begin
              Textcolor(k);
              Textbackground(5);

              Gotoxy(37,9) ;Write('ANAMENU');
              Gotoxy(33,11);Write('KAYIT GIRISI');
              Gotoxy(33,12);Write('KAYIT LISTELEME');
              Gotoxy(33,13);Write('KAYIT SILME');
              Gotoxy(33,14);Write('KAYIT DUZELTME');
              Gotoxy(33,15);Write('KAYIT ARAMA');
              Gotoxy(33,16);Write('CIKIS [ESC]');
          End;

          (**************** MENU SECIMI *******************)

          Procedure Menu_sec(var s:integer;r:integer);
          Begin
              Textcolor(r);
              Case s of
               11:begin Gotoxy(33,11); Write('KAYIT GIRISI')    ;end;
               11:begin gotoxy(46,11); write('deneme'); end;
               12:begin Gotoxy(33,12); Write('KAYIT LISTELEME') ;end;
               13:begin Gotoxy(33,13); Write('KAYIT SILME')     ;end;
               14:begin Gotoxy(33,14); Write('KAYIT DUZELTME')  ;end;
               15:begin Gotoxy(33,15); Write('KAYIT ARAMA')     ;end;
               16:begin Gotoxy(33,16); Write('CIKIS [ESC]')     ;end;
              end;
          End;

          (***************** MENU KONTROL *****************)

          Procedure Menu_kontrol;
          Var
              sec    : char     ;
              kar,y,i: integer  ;
          Begin

            Cer_ciz(5)   ;
            Kursor(false);
            Menu_yaz(14) ;
            y:=11        ;
            Textbackground(1);
            Gotoxy(32,y);Write(' ':16);
            Menu_sec(y,11);
            Repeat
             sec  :=readkey ;
             kar  :=ord(sec);

             Case kar of
              64:begin
                   Textbackground(5)          ;
                   Gotoxy(65,y);Write(' ':16) ;
                   Menu_sec(y,11)             ;
                   y:=y+1;
                    if y<11 then y:=47;
                       Textbackground(1);
                       Gotoxy(32,y);Write(' ':16);
                       Menu_sec(y,11);
              end;
              72:begin
                   Textbackground(5)          ;
                   Gotoxy(32,y);Write(' ':16) ;
                   Menu_sec(y,14)             ;
                   y:=y-1;
                    if y<11 then y:=16;
                       Textbackground(1);
                       Gotoxy(32,y);Write(' ':16);
                       Menu_sec(y,11);
                 end;

              80:begin
                   Textbackground(5);
                   Gotoxy(32,y);Write(' ':16);
                   Menu_sec(y,14);
                   y:=y+1;
                    If y>16 then y:=11;
                      Textbackground(1);
                      Gotoxy(32,y);Write(' ':16);
                      Menu_sec(y,11);
                 end;
             end;
            Until (sec=#13) or (sec=#27);

                  If sec=#27 then y:=16 ;
                      Case y of
                        11: begin giris     ; end;
                        12: begin listeleme ; end;
                        13: begin silme     ; end;
                        14: begin duzeltme  ; end;
                        15: begin arama     ; end;
                        16: begin
                                  zeminrengi(blue);
                                  cikis_menu;
                                  halt(0);
                            end;
                      end; {case}
          End; {ana}
                 (***************** ANA PROGRAM *****************)

          BEGIN
            Assign(Dosya,'C:\Kimlik.dat');
            {$I-}
            Reset(dosya);
            {$I+}
            If ioresult <> 0 then Rewrite(dosya);

              Repeat
                Clrscr;
                Zeminrengi(0);
                Ana_cerceve;
                Menu_kontrol;
              Until false;
            Close(dosya);
          END.


Yorumlar                 Yorum Yaz
Bu hazır kod'a ilk yorumu siz yapın!
KATEGORİLER
ASP - 240
ASP.NET - 24
C# - 75
C++ - 174
CGI - 8
DELPHI - 247
FLASH - 49
HTML - 536
PASCAL - 246
PERL - 11
PHP - 160
WML - 9
XML - 2
Copyright © 2002 - 2024 Hazır Kod - Tüm Hakları Saklıdır.
Siteden yararlanırken gizlilik ilkelerini okumanızı tavsiye ederiz.
hazirkod.com bir İSOBİL projesidir.