Программа, реализует следующую игру: один игрок, в роли которого компьютер, задумывает двузначное число, другой пытается его отгадать за минимальное число попыток. После каждой попытки первый игрок сообщает второму о том, больше или меньше названного задуманное число. Эта игра известна как "Угадай число" или "Быки и коровы". Легко изменить диапазон чисел, "задумываемых" компьютером - просто укажите другое значение NMax.

program Guess;
 
uses Crt;
const ESC=#27; ENTER=#13; UP=#72; DOWN=#80;
      NMax=100; {Верхняя граница чисел, можно поставить другую}
var Num,Input,Count,All,Balls:integer;
    Ch:Char;
 
procedure WriteC (c,r:integer; s:char);
begin
 GotoXy (c,r); Write (s);
end;
 
procedure Draw (c1,r1,c2,r2,text,back:integer);
 {Заливка области экрана атрибутом}
var mem: ^byte;
    c:byte;
    i,j:integer;
begin
 TextColor (text); TextBackGround (back);
 for i:=c1 to c2 do for j:=r1 to r2 do begin
  gotoxy (i,j);
  write (' ');
 end;
end;
 
procedure DrawWindow (c1,r1,c2,r2,bordcolor,bkcolor:integer);
{ Рисование окна по координатам от (c1,r1) до (c2,r2)
  цветом bordcolor на фоне bkcolor }
var i:integer;
begin
          Draw (c1,r1,c2,r2,bordcolor,bkcolor);
          WriteC (c1,r1,'╔');
          WriteC (c2,r1,'╗');
          WriteC (c1,r2,'╚');
          WriteC (c2,r2,'╝');
          for i:=r1+1 to r2-1 do begin
              WriteC (c1,i,'║');
              WriteC (c2,i,'║');
          end;
          for i:=c1+1 to c2-1 do begin
              WriteC (i,r1,'═');
              WriteC (i,r2,'═');
          end;
end;
 
procedure DefaultScreen;
begin
     TextColor (LIGHTGRAY);
     TextBackGround (BLACK);
     ClrScr;
end;
 
begin
     DefaultScreen;
     All:=0;
     Balls:=0;
     Window (1, 1, 80, 25);
     DrawWindow (5,5,75,20,yellow,blue);
     Window (6, 6, 74, 19);
     Writeln('УГАДАЙ ЧИСЛО!');
     Writeln('-------------------------------------------------------');
     Writeln('Программа, реализует  следующую игру:');
     Writeln('Один игрок,в роли которого компьютер, задумывает двузначное');
     Writeln('число, другой - человек - пытается его отгадать за минимальное');
     Writeln('число попыток. После каждой попытки первый игрок сообщает');
     Writeln('второму  о том, больше или меньше названного задуманное число.');
     Writeln('-------------------------------------------------------');
     Writeln('Очки  начисляются  в  зависимости от числа попыток - чем');
     Writeln('их меньше, тем больше очков Вы заработаете!');
     WriteLn;
     Randomize;
     repeat
      WriteLn ('Нажмите ESC для выхода или любую клавишу для игры...');
      Ch:=UpCase(ReadKey);
      if Ch=ESC Then Halt;
      Count:=0;
      Num:=Random (NMax-1)+1;
      repeat
       write ('Введите число или 0 для завершения партии:');
       readln (Input);
       Count:=Count+1;
       if Input=0 then break
       else if Input>Num then writeln ('Мое число меньше!')
       else if Input<Num then writeln ('Мое число больше!')
       else begin
        Inc(All);
        If Count<10 Then Balls:=Balls+(11-Count)*5;
        writeln ('Вы угадали! Это ',Num);
        writeln ('Ваше число попыток: ',Count);
        writeln ('Число очков:        ',Balls);
        writeln ('Число партий:       ',All);
        break;
       end;
      until false;
     until false;
     DefaultScreen;
end.

гостевая; E-mail