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

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Крестики
сообщение
Сообщение #1





Группа: Пользователи
Сообщений: 3

Репутация: -  0  +


Ребята ну хотя бы с крестиками помогите:
Игра крестики - нолики: Сделать так чтобы при нажатии ALT поле смещалось в другое место. Вместе со всеми ходами которые были сделаны и при этом продолжать играть на новом месте(старый экран затирается). Блин у меня не получается чтобы курсор вверх бегал...ПОМОГИТЕ:Вот исходник моей проги
Код
program krestiki_noliki;
uses
crt;
var
m:array[1..3,1..3] of char;
c,f1,f2:char;
f,e,w:boolean;
i,j,x,y:byte;
begin
while true do
begin
c:=#0;
f1:=#0;
f2:=#0;
e:=false;
w:=false;
f:=false;
for i:=1 to 3 do
for j:=1 to 3 do
m[i,j]:=#0;
clrscr;
writeln('Choose your destiny');
writeln('Krestiki(Enter X)');
writeln('Noliki(Enter O)');
writeln('Esc - Exit');
while (c=#0)or(c<>#27)and(c<>'x')and(c<>'X')and(c<>'o')and(c<>'O') do
begin
c:=readkey;
case c of
#27: exit;
'x','X': begin
f:=true;
f1:='X';
f2:='O';
end;
'o','O': begin
f:=false;
f1:='O';
f2:='X';
end;
end;
end;
clrscr;
writeln('ЪДДДВДДДВДДДї');
writeln('і і і і');
writeln('ГДДДЕДДДЕДДДґ');
writeln('і і і і');
writeln('ГДДДЕДДДЕДДДґ');
writeln('і і і і');
writeln('АДДДБДДДБДДДЩ');
gotoXY(3,2);
while e=false do
begin
if f=true then
begin
c:=readkey;
if c=#0 then
c:=readkey;
end
else
c:=#32;
case c of
#27: exit;
#32: begin
case whereX of
3: x:=1;
7: x:=2;
11: x:=3;
end;
case whereY of
2: y:=1;
4: y:=2;
6: y:=3;
end;
if m[x,y]=#0 then
begin
if (f=true)and(w=false)and(e=false) then
begin
write(f1);
gotoXY(whereX-1,whereY);
m[x,y]:=f1;
end;
if
(m[1,1]=f1)and(m[2,1]=f1)and(m[3,1]=f1)or
(m[1,2]=f1)and(m[2,2]=f1)and(m[3,2]=f1)or
(m[1,3]=f1)and(m[2,3]=f1)and(m[3,3]=f1)or
(m[1,1]=f1)and(m[1,2]=f1)and(m[1,3]=f1)or
(m[2,1]=f1)and(m[2,2]=f1)and(m[2,3]=f1)or
(m[3,1]=f1)and(m[3,2]=f1)and(m[3,3]=f1)or
(m[1,3]=f1)and(m[2,2]=f1)and(m[3,1]=f1)or
(m[1,1]=f1)and(m[2,2]=f1)and(m[3,3]=f1) then
begin
gotoXY(1,8);
writeln('Крестики выйграли');
readln;
w:=true;
e:=true;
end;
f:=true;
if (w=false)and(e=false) then
begin
while m[x,y]<>#0 do
begin
x:=1+random(3);
y:=1+random(3);
end;
case x of
1: gotoXY( 3,whereY);
2: gotoXY( 7,whereY);
3: gotoXY(11,whereY);
end;
case y of
1: gotoXY(whereX, 2);
2: gotoXY(whereX, 4);
3: gotoXY(whereX, 6);
end;
write(f2);
gotoXY(whereX-1,whereY);
m[x,y]:=f2;
if
(m[1,1]=f2)and(m[2,1]=f2)and(m[3,1]=f2)or
(m[1,2]=f2)and(m[2,2]=f2)and(m[3,2]=f2)or
(m[1,3]=f2)and(m[2,3]=f2)and(m[3,3]=f2)or
(m[1,1]=f2)and(m[1,2]=f2)and(m[1,3]=f2)or
(m[2,1]=f2)and(m[2,2]=f2)and(m[2,3]=f2)or
(m[3,1]=f2)and(m[3,2]=f2)and(m[3,3]=f2)or
(m[1,3]=f2)and(m[2,2]=f2)and(m[3,1]=f2)or
(m[1,1]=f2)and(m[2,2]=f2)and(m[3,3]=f2) then
begin
gotoXY(1,8);
writeln(Нолики - выйграли);
readln;
w:=true;
e:=true;
end;
end;
if
(w=false)and(e=false)and
(m[1,1]<>#0)and(m[2,1]<>#0)and(m[3,1]<>#0)and
(m[2,1]<>#0)and(m[2,2]<>#0)and(m[3,2]<>#0)and
(m[3,1]<>#0)and(m[2,3]<>#0)and(m[3,3]<>#0) then
begin
gotoXY(1,8);
writeln('­Ничья');
readln;
e:=true;
end;
end;
end;
#72: if (whereX<=11) and (whereY-2<=6) then
gotoXY(whereX,whereY-2);
#75: if (whereX-4<=11) and (whereY<=6) then
gotoXY(whereX-4,whereY);
#77: if (whereX+4<=11) and (whereY<=6) then
gotoXY(whereX+4,whereY);
#80: if (whereX<=11) and (whereY+2<=6) then
gotoXY(whereX,whereY+2);
end;
end;
end;
end.


Сообщение отредактировано: volvo -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Бывалый
***

Группа: Пользователи
Сообщений: 239
Пол: Женский
Реальное имя: Юлия

Репутация: -  3  +


Когда прочитаешь внимательно правила раздела тогда поможем!! angry.gif


--------------------
For every evil under the sun
There is a remedy or there is none
If there is one - try to find it
If there is none - never mind it!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Знаток
****

Группа: Пользователи
Сообщений: 419
Пол: Мужской

Репутация: -  6  +


да мы и так поможем :
Код
program krestiki_noliki;
uses crt;
var m:array[1..3,1..3] of char;
   c,ch,f1,f2:char;
   f,e,w:boolean;
   i,j,x,y:byte;
   lx,ly:integer;

procedure outp;
var x,y:integer;
begin
  clrscr;
  gotoXY(lx,ly);
  writeln('ЪДДДВДДДВДДДї');gotoXY(lx,ly+1);
  writeln('і   і   і   і');gotoXY(lx,ly+2);
  writeln('ГДДДЕДДДЕДДДґ');gotoXY(lx,ly+3);
  writeln('і   і   і   і');gotoXY(lx,ly+4);
  writeln('ГДДДЕДДДЕДДДґ');gotoXY(lx,ly+5);
  writeln('і   і   і   і');gotoXY(lx,ly+6);
  writeln('АДДДБДДДБДДДЩ');
  for y:=1 to 3 do
  for x:=1 to 3 do
  begin
     case x of
      1: gotoXY(lx+2,whereY);
      2: gotoXY(lx+6,whereY);
      3: gotoXY(lx+10,whereY);
     end;
     case y of
      1: gotoXY(whereX,ly+1);
      2: gotoXY(whereX,ly+3);
      3: gotoXY(whereX,ly+5);
     end;
     if m[x,y]<>#0 then write(m[x,y]);
  end;
end;

begin
  lx:=1;ly:=1;
  while true do
  begin
     c:=#0;
     f1:=#0;
     f2:=#0;
     e:=false;
     w:=false;
     f:=false;
     for i:=1 to 3 do
        for j:=1 to 3 do
           m[i,j]:=#0;
     clrscr;
     writeln('Choose your destiny');
     writeln('Krestiki(Enter X)');
     writeln('Noliki(Enter O)');
     writeln('Esc - Exit');
     while (c=#0)or(c<>#27)and(c<>'x')and(c<>'X')and(c<>'o')and(c<>'O') do
        begin
           c:=readkey;
           case c of
            #27: exit;
            'x','X': begin
                        f:=true;
                        f1:='X';
                        f2:='O';
                     end;
            'o','O': begin
                        f:=false;
                        f1:='O';
                        f2:='X';
                     end;
           end;
        end;
clrscr;
writeln('ЪДДДВДДДВДДДї');
writeln('і   і   і   і');
writeln('ГДДДЕДДДЕДДДґ');
writeln('і   і   і   і');
writeln('ГДДДЕДДДЕДДДґ');
writeln('і   і   і   і');
writeln('АДДДБДДДБДДДЩ');
gotoXY(3,2);
  while e=false do
  begin
     if f=true then
     begin
        c:=readkey;
        if c=#0 then
        c:=readkey;
     end else
         c:=#32;
     case c of
      #27: exit;
      #32: begin
              case (whereX-lx+1) of
               3: x:=1;
               7: x:=2;
               11: x:=3;
              end;
              case (whereY-ly+1) of
               2: y:=1;
               4: y:=2;
               6: y:=3;
              end;
              if m[x,y]=#0 then
              begin
                 if (f=true)and(w=false)and(e=false) then
                 begin
                    write(f1);
                    gotoXY(whereX-1,whereY);
                    m[x,y]:=f1;
                 end;
                 if (m[1,1]=f1)and(m[2,1]=f1)and(m[3,1]=f1)or
                    (m[1,2]=f1)and(m[2,2]=f1)and(m[3,2]=f1)or
                    (m[1,3]=f1)and(m[2,3]=f1)and(m[3,3]=f1)or
                    (m[1,1]=f1)and(m[1,2]=f1)and(m[1,3]=f1)or
                    (m[2,1]=f1)and(m[2,2]=f1)and(m[2,3]=f1)or
                    (m[3,1]=f1)and(m[3,2]=f1)and(m[3,3]=f1)or
                    (m[1,3]=f1)and(m[2,2]=f1)and(m[3,1]=f1)or
                    (m[1,1]=f1)and(m[2,2]=f1)and(m[3,3]=f1) then
                       begin
                          gotoXY(1,30);
                          writeln('Крестики выйграли');
                          readln;
                          w:=true;
                          e:=true;
                       end;
                 f:=true;
                 if (w=false)and(e=false) then
                    begin
                       while m[x,y]<>#0 do
                       begin
                          x:=random(3)+1;
                          y:=random(3)+1;
                       end;
                       case x of
                        1: gotoXY(lx+2,whereY);
                        2: gotoXY(lx+6,whereY);
                        3: gotoXY(lx+10,whereY);
                       end;
                       case y of
                        1: gotoXY(whereX,ly+1);
                        2: gotoXY(whereX,ly+3);
                        3: gotoXY(whereX,ly+5);
                       end;
                       write(f2);
                       gotoXY(whereX-1,whereY);
                       m[x,y]:=f2;
                       if (m[1,1]=f2)and(m[2,1]=f2)and(m[3,1]=f2)or
                          (m[1,2]=f2)and(m[2,2]=f2)and(m[3,2]=f2)or
                          (m[1,3]=f2)and(m[2,3]=f2)and(m[3,3]=f2)or
                          (m[1,1]=f2)and(m[1,2]=f2)and(m[1,3]=f2)or
                          (m[2,1]=f2)and(m[2,2]=f2)and(m[2,3]=f2)or
                          (m[3,1]=f2)and(m[3,2]=f2)and(m[3,3]=f2)or
                          (m[1,3]=f2)and(m[2,2]=f2)and(m[3,1]=f2)or
                          (m[1,1]=f2)and(m[2,2]=f2)and(m[3,3]=f2) then
                             begin
                                gotoXY(1,30);
                                writeln('Нолики - выйграли');
                                readln;
                                w:=true;
                                e:=true;
                             end;
                    end;
                    if (w=false)and(e=false)and
                       (m[1,1]<>#0)and(m[2,1]<>#0)and(m[3,1]<>#0)and
                       (m[2,1]<>#0)and(m[2,2]<>#0)and(m[3,2]<>#0)and
                       (m[3,1]<>#0)and(m[2,3]<>#0)and(m[3,3]<>#0) then
                          begin
                             gotoXY(1,30);
                             writeln('Ничья');
                             readln;
                             e:=true;
                          end;
              end;
           end;
      #72: if whereY>ly+1 then gotoXY(whereX,whereY-2);
      #75: if whereX>lx+3 then gotoXY(whereX-4,whereY);
      #77: if whereX<lx+8 then gotoXY(whereX+4,whereY);
      #80: if whereY<ly+5 then gotoXY(whereX,whereY+2);
      'a','A':begin
                 ch:=readkey;
                 if ch=#0 then ch:=readkey;
                 while not (ch in ['a','A']) do
                 begin
                    case ch of
                     #72:if ly>1 then dec(ly);
                     #75:if lx>1 then dec(lx);
                     #77:if lx<60 then inc(lx);
                     #80:if ly<15 then inc(ly);
                    end;
                    outp;
                    ch:=readkey;
                    if ch=#0 then ch:=readkey;
                 end;
              end;
     end;
  end;
  end;
end.


--------------------
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 





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