меню на pascal |
Начальные контакты ТОЛЬКО через личку!!
меню на pascal |
fanat94 |
16.04.2012 19:10
Сообщение
#1
|
Группа: Пользователи Сообщений: 1 Пол: Мужской Репутация: 0 |
Тут одна проблема:
Не работает exe - файл exe('kalkulya,exe',a); break; Вот код: {$M 16384,0,16384} program menu; uses crt,dos,graph; type stroka=array [1..3] of string[16]; const item1:array[1..4]of string[15]=('‡*ў¤***п','Џа®Ја*¬*','„®Ї®¬®Ј*', '‚Ёеi¤'); item2:stroka=('‡*ў¤***п','Џа® *ўв®а*','Љ®¬Ї«ҐЄб*i зЁб«a'); item3:stroka=('Џа® Їа®Ја*¬г','‚ЁЄ®****п',''); item4:stroka=('„®Ї®¬®Ј*','Љ*«мЄг«пв®а',''); otstup=10; var i,j:integer; kol,gd,gm:integer; key,vertkey:char; metca,metca2:boolean; name:string; f:text; procedure choose(a:integer);forward; procedure clearvert(x1,y1,x2,y2:integer;colora:integer);forward; procedure text(name:string;a:integer);forward; procedure exe(name:string;a:integer);forward; procedure active(j:integer); begin gotoxy((80 div kol)*j-otstup,1); textcolor(red); textbackground(green); write(item1[j]); end; procedure deactive(j:integer); begin if j>kol then exit; gotoxy((80 div kol)*j-otstup,1); textcolor(black); textbackground(lightgray); write(item1[j]); end; procedure mainmenu ( kol:integer); var j:integer; begin window(1,22,80,22); write(' ENTER-ўЁЎiа ESC-бЄ*бгў***п ',chr(26),' ',chr(27),' - ЇҐаҐ¬iйҐ**п Єгаб®а*'); metca:=true; window(1,1,80,1); textbackground(lightgray); clrscr; for j:=1 to kol do begin gotoxy((80 div kol)*j-otstup,1); if j=1 then active(j) else deactive(j); end; j:=1; repeat key:=readkey; if (key=#0) and keypressed then key:=readkey; case key of #77: begin deactive(j); inc(j); if j=kol+1 then j:=1; active(j); end; #75: begin deactive(j); dec(j); if j<1 then j:=kol; active(j); end; #13: choose(j); end; until metca=false; end; procedure vertmenu(kol1:integer; mas:stroka; a:integer); var j:integer; metca2:boolean; procedure activevert(j:integer); begin gotoxy(5,j*2-1); textcolor(red); textbackground(green); write(mas[j]); end; procedure deactivevert(j:integer); begin gotoxy(5,j*2-1); textcolor(black); textbackground(lightgray); write(mas[j]); end; begin textbackground(lightgray); textcolor(black); window((80 div kol)*a-otstup,2,(80 div kol)*(a+1)-otstup,kol1*2); clrscr; for j:=1 to kol1 do begin if j=1 then activevert(j) else deactivevert(j); end; j:=1; metca2:=true; repeat vertkey:=readkey; if vertkey=#0 then vertkey:=readkey; case vertkey of #80: begin deactivevert(J); inc(j); if j=kol1+1 then j:=1; activevert(j); end; #72:begin deactivevert(j); dec(j); if j<1 then j:=kol1; activevert(j); end; #27: begin clearvert((80 div kol)*a-otstup,2,(80 div kol)*(a+1)-otstup,kol*2,0); metca2:=false; end; #13:begin clearvert((80 div kol)*a-otstup,2,(80 div kol)*(a+1)-otstup,kol1*2,0); case a of 1: begin case j of 1: begin text('zavdan.pas',a); break; end; 2: begin text('avtor.pas',a); break; end; 3: begin text('komchisl.pas',a); break; end; end; end; 2: begin case j of 1: begin text('kod_komplex.pas',a); break; end; 2: begin exe('komplex.exe',a); break; end; end; end; 3: begin case j of 1: begin text('help.pas',a); break; end; 2:begin exe('kalkulya.exe',a); break; end; end; end; end; end; end; until metca2=false; end; procedure choose(a:integer); begin case a of 1:begin vertmenu(3,item2,1); end; 2:begin vertmenu(2,item3,2); end; 3:begin vertmenu(2,item4,3); end; 4:begin metca:=false; window(1,1,80,1); textbackground(0); textcolor(15); clrscr; window(1,1,80,22); clrscr; end; end; end; procedure clearvert(x1,y1,x2,y2:integer;colora:integer); begin textbackground(colora); window(x1,y1,x2,y2); clrscr; window(1,1,80,25); end; procedure text(name:string;a:integer); var str:string; l: Integer; begin window(1,1,80,1); deactive(a); assign(f,name); reset(f); I:=1; window(1,22,80,22); textcolor(15); textbackground(0); clrscr; write(' ENTER-ЇҐаҐЈ«п¤ ESC-ўi¤¬i** в* Ї®ўҐа*Ґ**п ў ¬Ґ*о') ; window(1,3,80,21); textbackground(1); textcolor(15); clrscr; while not eof(f) do begin readln(f,str); gotoxy(1,5+l); writeln(str); i:=i+1; if l=15 then begin if readkey=#27 then begin clrscr; break; end; l:=1; clrscr; end; end; readkey; window(1,22,80,22); textcolor(15); textbackground(0); clrscr; write(' ENTER-ўЁЎiа ESC-бЄ*бгў***п ',chr(26),' ',chr(27),' -ЇҐаҐ¬iйҐ**п Єгаб®а*'); window(1,3,80,21); textbackground(0); clrscr; close(f); window(1,1,80,1); active(a); if vertkey=#13 then choose(a); end; procedure exe(name:string;a:integer); begin window(1,2,80,22); textbackground(0); textcolor(15); swapvectors; exec(name,''); if Doserror<>0 then begin Writeln('Doserror=',Doserror); readkey; end; swapvectors; clrscr; window(1,1,80,1); textbackground(lightgray); clrscr; active(a); deactive(a-1); deactive(a+1); deactive(a+2); window(1,22,80,22); textcolor(15); textbackground(0); clrscr; write(' ENTER-ўЁЎiа ESC-бЄ*бгў***п ',chr(26),' ',chr(27),' -ЇҐаҐ¬iйҐ**п Єгаб®а*'); window(1,1,80,21); textbackground(0); end; begin gd:=detect; initgraph(gd,gm,''); setcolor(white); rectangle(160,50,480,400); rectangle(170,60,470,390); setcolor(green); outtextxy(300,100,'Љ“ђ‘Ћ‚Ђ'); outtextxy(300,180,'Ќ* ⥬г:'); outtextxy(225,210,'ЉЋЊЏ‹…Љ‘ЌI —€‘‹Ђ ‚ ЏЂ‘ЉЂ‹I'); outtextxy(190,320,'‚ЁЄ®**ў бв㤥*в ЈагЇЁ ЏЉ-102'); outtextxy(190,340,'џ¬йiЄ®ў „¬Ёва®'); outtextxy(300,370,'2012 аiЄ'); readln; restorecrtmode; textbackground(0); clrscr; kol:=4; mainmenu(kol); end. Прикрепленные файлы menu.rar ( 66.49 килобайт ) Кол-во скачиваний: 154 |
Текстовая версия | 25.09.2024 18:05 |