Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 14.06.2015, 20:48   #1
Боря1234567
Новичок
Джуниор
 
Регистрация: 13.06.2015
Сообщений: 5
По умолчанию Помогите пожалуйста. Турбо Паскаль. Меню.

Помогите пожалуйста, как в этом меню сделать листание стрелками и вход через энтер.

Заранее спасибо)

Код программы:
Код:
Uses CRT;
  
procedure menu2(var n: integer);
Const K=4;
StrMenu: array [1..k] of string [20]=
('1.Igra',
 '2.Info',
 '3.File',
 '4.Vixod');
 {restorecrtmode=;}
var i:integer;
Nch: char;
Begin
Clrscr;
TextColor(5);
Gotoxy(35,4);
Writeln('Menu');
TextColor(7);
For i:=1 to k do
 Begin
   GotoXY(25,6+i);
   Write(StrMenu[i]);
   end;
TextColor(2);
Gotoxy(10,6+k+2);
WriteLN('vibirite deistvie i nazmite enter');
i:=1;
TextColor(4);
Gotoxy(25,6+i);
Write(StrMenu[i]);
Repeat
Nch:= readKey;

Case ord(nch) of
      38: begin
      TextColor(1);
      GotoXY(25,6+i);
      Write(StrMenu[i]);
      Dec(i);
      If i<1 then i:=k;
      TextColor(4);
      GotoXY(25,6+i);
      Write(StrMenu[i]);
      end;

      40: begin {стрелка вверх}
      TextColor(9);
      Gotoxy(25,6+i);
      Write(StrMenu[i]);
      Inc(i);
      If i>k then i:=1;
      TextColor(4);
      gotoxy(25,6+i);
      write(strmenu[i]);
      end;
27: halt;
end;

Until ord(nch)=13;
N:=i;
procedure progg;
begin
clrscr;
WriteLN('программа');
readlN;
end;
procedure sprav;
begin
clrscr;
WriteLN('Даная программа предназначена для интерпритации настоящего пианино');
ReadLN;
end;

procedure instr;
begin
Clrscr;
WriteLN('Инструкция : Чтобы начать играть нажмите "Играть" ');
readln;
end;

procedure out;
begin
Clrscr;
WriteLN('выход');
readln;
end;
var n:integer;
begin
 
repeat
clrscr;
menu2(n);
case n of
1: progg;
2: sprav;
3: instr;

end;
Until n=4;
 
end.

Последний раз редактировалось Аватар; 14.06.2015 в 21:25.
Боря1234567 вне форума Ответить с цитированием
Старый 15.06.2015, 10:32   #2
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,229
По умолчанию

твой код мне проверить негде, посмотри рабочий пример меню - ТУТ
может, он тебе окажется полезным.
Serge_Bliznykov вне форума Ответить с цитированием
Старый 15.06.2015, 12:51   #3
Боря1234567
Новичок
Джуниор
 
Регистрация: 13.06.2015
Сообщений: 5
Восклицание Меню

Помогите пожалуйста. Меню не много доработать. Нужно чтобы при в ходе , например в инструкцию, можно было бы обратно вернуться в меню.

код программы:

Код:
uses Crt,Keyboard,Dos;
const
	num_notes=12;
	M:array[1..num_notes] of integer = (262,277,294,311,330,349,370,392,415,440,466,494);

	ke2:array [1..num_notes] of byte=(kQ,k2,kW,k3,kE,kR,k5,kT,k6,kY,k7,kU);
	keys:string='q2w3er5t6y7uzsxdcvgbhnjm,';
	Nums:array[1..num_notes] of integer=(1,1,2,2,3,4,4,5,5,6,6,7);
var
	Ch: char;
        status:boolean;
	t,i,n,n1,Huynya: word;
	KBD: KeyboardObj;
 procedure Hide_Cursor;
   var Regs : Registers;
 begin
   with Regs do
    begin
      Ah:=1;
      Ch:=$20;
      Cl:=0;
      Bh:=0;
      Intr($10,Regs);
    end;
 end;

procedure DrawKey(n:word; hold:boolean);
var
	x,y,i:integer;
	t:(BlackKey,WhiteKey,ErrorKey);
begin
	t:=ErrorKey;
	if n <= num_notes then t:=BlackKey;
	if n in [1,3,5,6,8,10,12] then t:=WhiteKey;
	n:=Nums[n];
	case t of
		BlackKey:begin
    					 TextColor(DarkGray);
               if hold then
               TextColor(Red);
           		 x:=n*4;
	   					 for y:=1 to 3 do begin
	     				 	 GoToXY(x-1,y);
	     				 	 write('ЫЫЫ');
	   					 end;
    				 end;
		WhiteKey:begin
           		 TextColor(White);
           		 if Hold then
           		 TextColor(LightRed);
           		 x:=n*4;
           		 for y:=1 to 5 do begin
             	   GoToXY(x-2,y);
    						 write('Ы');
           		 end;
           		 i:=4;
           		 if n in [3,7,10] then i:=1;
    					 for y:=i to 5 do begin
             		 GoToXY(x-1,y);
             		 write('Ы');
           		 end;
           		 i:=4;
    					 if n in [1,4,8,11] then i:=1;
           		 for y:=i to 5 do begin
             		 GoToXY(x-3,y);
             		 write('Ы');
           		 end;
           		 i:=4;
           		 if n in [3,7,10] then i:=1;
           		 for y:=i to 5 do begin
               	 GoToXY(x,y);
             		 write('Э');
           		 end;
    				 end;
	end;
	TextColor(LightGray);
	GoToXY(1,1);
end;
procedure pianino;
begin
Hide_Cursor;
	TextBackground(Black);
	Writeln('€¤св §*Јаг§Є* н«ҐЄва®®аЈ***... ќв® *Ґ ¬®¦Ґв §**пвм *ҐбЄ®«мЄ® ¬Ё*гв... Ђ Ґб«Ё    §*©¬св, в® §**зЁв, Їа®Ј* Ї®ўЁб«*',
					' (Ё«Ё Є®¬Ї ¬Ґ¤«Ґ**л© :) )...');
	Delay(500);
	ClrScr;
	KBD.Init;
	for n:=1 to num_notes do
		DrawKey(n,False);
	for n:=1 to num_notes do begin
		if n in [1,3,5,6,8,10,12] then
			GoToXY(Nums[n]*4-2,7)
		else
			GoToXY(Nums[n]*4,6);
		write(keys[n]);
	end;
	repeat
		n1:=n;
		n:=0;
		for i:=1 to num_notes do
			if KBD.Down(ke2[i]) and (n=0) then
				n:=i
			else if n1=i then begin
				NoSound;
				DrawKey(i,False);
			end;
		if n<>0 then begin
			if n1=0 then
				DrawKey(n1,False);
			Sound(M[n]);
			DrawKey(n,True);
		end
		else
			n:=n1;
		Delay(10);
	until KBD.Down(kEsc);
	NoSound;
	TextColor(LightGray);
	ClrScr;
end;
procedure instruction;
var instr:text;
s:string;
begin
ClrScr;
writeln('Simulator pianino. Instrukciya')
writeln;
writeln('Nota `do` = klavisha `q`');
writeln('Nota `do diez` = klavisha `2`');
writeln('Nota `re` = klavisha `w`');
writeln('Nota `re diez` = klavisha `2`');
writeln('Nota `mi` = klavisha `e`');
writeln('Nota `fa` = klavisha `r`');
writeln('Nota `fa diez` = klavisha `5`');
writeln('Nota `lya` = klavisha `t`');
writeln('Nota `lya diez` = klavisha `6`');
writeln('Nota `si` = klavisha `y`');
writeln('Nota `si diez` = klavisha `7`');
writeln('Nota `sol` = klavisha `u`');
readkey;
end;
procedure firstStart;
begin
while (not status) do begin
writeln('Select');
writeln('1)Play');
writeln('2)Instruction');
writeln('3)Exit');
case readkey of
#49:begin
status:=true;
pianino;
end;
#50:begin
status:=true;
instruction;
end;
#51:exit;
end;
ClrScr;
end;
end;
begin
firstStart;
end.
Правильно оформляй код - кнопка # вверху

Последний раз редактировалось Аватар; 15.06.2015 в 12:54.
Боря1234567 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
помогите пожалуйста. Турбо паскаль! Naruto63 Помощь студентам 2 21.11.2009 10:58
ПОМОГИТЕ ПОЖАЛУЙСТА, 2 задачи на Турбо-Паскаль !!!! (я нуб !!!! ) ProFi-TM Паскаль, Turbo Pascal, PascalABC.NET 0 12.04.2009 20:28
Помогите пожалуйста решить задачу с вращением объёмного тела! (Турбо Паскаль) mens-evgenij Помощь студентам 10 12.03.2009 18:07
Пожалуйста,помогите составить программу задачи на языке Турбо Паскаль-задача на функцию Jan Помощь студентам 1 07.01.2009 19:39
Помогите пожалуйста с задачей в Турбо Паскаль. Bulvai Помощь студентам 1 25.06.2008 18:09