Версия для печати темы

Автор: compiler 9.05.2007 18:05

вот решил написать эту программу, та както не работает...
Помогите, пожалуйста

Uses Crt;

procedure Menu;
	begin
		clrscr();
		TextColor(LightGreen);
		WriteLn;
		
		WriteLn(' УГАДАЙ ЧИСЛО'); 
		WriteLn;
		WriteLn('Сыграем?');
		WriteLn(' y: Старт');
		WriteLn;
		WriteLn(' n: Выход');
		WriteLn( #10#13, #10#13, #10#13, #10#13, #10#13);
		WriteLn(' Выбор: ');
	end;


procedure victory(j:byte);
	begin
		writeln('Поздравляем Вы победили за', j ,'попыток');
		readln;
		read;
	end;

procedure looser (RandInt:byte);
	begin
		writeln('Вы проиграли...');
		writeln('Загаданное число:' , RandInt );
		readln;
		read;
	end;


procedure BeginGame;
	var
		RandInt, UserInt, j: byte;
	const
		 MaxInt: byte =100;
		 MaxJ: byte =10;
	begin
		TextColor(LightGreen);
		RandInt:=random(MaxInt);
		for j:=1 to MaxJ do begin
			WriteLn(' Введите число');
			ReadLn(UserInt);
			case   byte((UserInt - RandInt) > 0) + 2 * byte((UserInt - RandInt) < 0) of
				0: begin victory(j); exit end;
				1: writeln('Загаданное число меньше введеного');
				2: writeln('Загаданное число больше введеного');
				
			end;					
		end;
		menu;
	end;	

procedure EndGame;
	begin
		TextColor(LightRed);
		WriteLn(' ПРИХОДИТЕ ЕЩЕ...'); 
		
	end;

function Choice:boolean;
	var
		ch: char;
	begin
		ch:='q';
		while (ch<>'y') or (ch<>'n') do begin 
			ch := ReadKey;
			case ch of
				'y':Choice:=true;
				'n':Choice:=false;
			end;
		end;
		
	end;
begin
	Menu;
	if Choice =true then 	BeginGame
		else EndGame;
end.

ЗЫ -- компилятор FP.

Автор: мисс_граффити 9.05.2007 18:38

вот так:

function Choice:boolean;
var ch: char;
begin
ch:='q';
while (ch<>'y') and (ch<>'n') do
  ch:=ReadKey;
case ch of
'y':Choice:=true;
'n':Choice:=false;
end;

Автор: compiler 9.05.2007 18:52

дурацкая ошибка...

мисс_граффити, спасибо..

Автор: klem4 9.05.2007 21:24

немного короче

function Choice: Boolean;
var
  ch: char;
begin
  repeat ch := readkey until UpCase(ch) in ['Y', 'N'];
  Choice := (UpCase(ch) = 'Y');
end; 

Автор: compiler 9.05.2007 21:30

klem4, здорово... + ставить сегодня не могу(а так бы поставил...)

Автор: compiler 12.05.2007 21:52

собственно подредактировал (хотел зациклить, как-то не выходит) посмотрите пожалуйста..

Uses Crt;

procedure Menu;
	begin
		clrscr();
		TextColor(LightGreen);
		WriteLn;
		
		WriteLn(' УГАДАЙ ЧИСЛО'); 
		WriteLn;
		WriteLn('Сыграем?');
		WriteLn(' y: Старт');
		WriteLn;
		WriteLn(' n: Выход');
		WriteLn( #10#13, #10#13, #10#13, #10#13, #10#13);
		WriteLn(' Выбор: ');
	end;


procedure victory(j:byte);
	begin
		writeln('Поздравляем Вы победили за', j ,'попыток');
		repeat until not keypressed;
		(*Menu;*)
	end;

procedure looser (RandInt:byte);
	begin
		writeln('Вы проиграли...');
		writeln('Загаданное число:' , RandInt );
		repeat until not keypressed;
		(*Menu;*)
	end;


procedure BeginGame;
	var
		RandInt, UserInt, j: byte;
	const
		 MaxInt:	byte =100;
		 MaxJ: 	byte =10;
		 sleep:	integer =1;
	begin
		writeln(#10#13, 'Поехали!', #10#13);
		TextColor(LightGreen);
		RandInt:=random(MaxInt);
		for j:=1 to MaxJ do begin
			WriteLn(' Введите число');
			ReadLn(UserInt);
			Delay(sleep);
			case   byte((UserInt - RandInt) > 0) + 2 * byte((UserInt - RandInt) < 0) of
				0: begin victory(j); exit end;
				1: writeln('Загаданное число меньше введеного<');
				2: writeln('Загаданное число больше введеного>');
				
			end;					
		end;
		looser(RandInt);
	end;	

procedure EndGame;
	begin
		TextColor(LightRed);
		WriteLn(' ПРИХОДИТЕ ЕЩЕ...'); 
		Delay(2000);
		
	end;

function Choice: Boolean;
var
  ch: char;
begin
  repeat ch := readkey until UpCase(ch) in ['Y', 'N'];
  Choice := (UpCase(ch) = 'Y');
end;

begin
	repeat 
	Menu;
	if Choice =true then 	BeginGame
		else EndGame;
	until Choice =true;
end.

заранее благодарен.

Автор: volvo 12.05.2007 22:01

Ты второй раз вызывать Choice не должен - достаточно сделать так:

function EndGame: boolean;
begin
  TextColor(LightRed);
  WriteLn(' ПРИХОДИТЕ ЕЩЕ...'); 
  Delay(2000);
  EndGame := true;
end;

и теперь:

const
  b: boolean = false;
begin
  repeat

    Menu;
    if Choice then BeginGame
    else b := EndGame;

  until b;
end.

Автор: compiler 12.05.2007 22:11

по моему надо еще как-то изменить procedure victory...