|
depo kayýt(stok) programý
Program stok;
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:int eger); 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šSš>>> º'); 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('D'); delay(150);Gotoxy(4,8);Writeln('E'); delay(50);Gotoxy(5,8);Writeln('P'); delay(150);Gotoxy(6,8);Writeln('O'); 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('A'); delay(50);Gotoxy(15,8);Writeln('Y'); delay(150);Gotoxy(16,8);Writeln('G'); delay(50);Gotoxy(17,8);Writeln('U'); delay(150);Gotoxy(18,8);Writeln('N'); 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('.'); delay(50);Gotoxy(24,8);Writeln('.'); delay(150);Gotoxy(25,8);Writeln('.'); delay(50);Gotoxy(26,8);Writeln('.'); delay(150);Gotoxy(27,8);Writeln('.'); 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('2'); DELAY(50);Gotoxy(13,9);Writeln('.'); DELAY(150);Gotoxy(14,9);Writeln('1'); Gotoxy(3,11);Writeln('AYGUN YAZILIM '); GOTOXY(15,18);WRITELN('COPRIHT(c) GOKHAN AYGUN...'); Textcolor(red); Gotoxy(13,21); Writeln('BIZI TERCIH ETTGINIZ ICIN TESEKKURLER'); 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(3); 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(5); 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šSš >>>'); 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šZELTME'); Window(2,3,79,22) ; Prengi(1) ; kimlik_menu; TEXTCOLOR(YELLOW); gotoxy(26,2);write('<<< šRšN DšZELTME MENšSš >>>'); 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} (************** SA¦ OK TUSU *********************) procedure sag_ok; 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(4) ; Gotoxy(75,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; 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. |
Paylaşım için tşkler…
|
teŞekkÜrler PaylaŞim İİÇİn
|
paylaşım için tşkrlr
|
| Bütün Zaman Ayarları WEZ +3 olarak düzenlenmiştir. Şu Anki Saat: 02:20 . |
Powered by vBulletin® Version 3.7.0
Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.