IPB
ЛогинПароль:

> 

Начальные контакты ТОЛЬКО через личку!!

 
 Ответить  Открыть новую тему 
> меню на pascal
сообщение
Сообщение #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 килобайт ) Кол-во скачиваний: 307
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 20.04.2024 8:14
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name