Привет, Всем
Пытаюсь написать игру ханойские башни для сдачи курсовой (заочник) знаний пока не хватает, но тем что есть пытаюсь воспользоваться

Алгоритм такой:
Все пастроенно на массиве N строк и 3 столбца, далее этот массив заполняется так:
1 0 0
2 0 0
.......
N 0 0

далее нажатиями клавиш я перезаполняю массив по принципу ханойской башни. В результате добавлю гафическое отображение всех этих действий.
диски будут привязаны к элементам массива, строкам и столбцам. Вообщем пока не доработанно из за ожного сбоя.
Внимание вопрос:

вот исходник алгоритма заполнения матрици.

uses crt;
var
hb:array[1..9,1..3] of integer;
stop:boolean;
key:char;
i,j,n,m,k,l,a:integer;

begin
 clrscr;
 write('vvedite chislo diskov ');
 readln(m);
{writeln;}
 l:=1;
 k:=1;
 n:=3;
 a:=0;
 for i:=1 to m do
  begin
   for j:=1 to n do
    begin
     hb[i,j]:=k;
     write(hb[i,j]:3);
     k:=0;
    end;
   l:=l+1;
   k:=k+l;
   writeln;
  end;
writeln;
{readkey;}
writeln;
stop:=false;
while stop=false do
  begin
     if keypressed then
         key:=readkey;
         if (key='q') or (key='Q') then stop:=true;
         if (key='1') then j:=1;
         if (key='2') then j:=2;
         if (key='3') then j:=3;
{принажамтии клавиши вверх "а" присваевается знаяение элемента матрици 
вот тут то и проблема, привыборе второго столбца, в нем все элементы "0", 
"а" присваевается значение 10, привыборе третьего столбца "а" присваевается 
значение 3 откуда эти значения беруться я вообще понять не могу
 
помогите пожалуйста разобраться в принципе из за этого графическое 
представление всего этого действия и остановилось}
         if (ord(key)=72) then
           begin
            i:=0;
             repeat
              begin
                i:=i+1;
                a:=hb[i,j];
              end;
             until hb[i,j]>0;
            hb[i,j]:=0;
            end;
         if (ord(key)=80) then
            begin
            i:=0;
             repeat
              begin
                i:=i+1;
              end;
             until (hb[i,j]>0) or (i=m);
             if hb[i,j]=0 then
              begin
               hb[i,j]:=a;
               a:=0;
              end
              else
               begin
                if (a>=hb[i,j]) or (a=0) then writeln('NO') else
                 begin
                  i:=i-1;
                  hb[i,j]:=a;
                  a:=0;
                 end;
               end;
            end;
          if (ord(key)=13) then
             begin
              for i:=1 to m do
                begin
                  for j:=1 to n do
                   begin
                    write(hb[i,j]:3);
                   end;
                  writeln;
                end;
              writeln(a);
             end;
   key:=readkey;
 end;
end.

Как сделю все полностью закончу вывложу полный исходник может кому пригодится

М

При выкладывании кода, пожалуйста, используй теги. Лопарь

Четвертый-то? Вообще-то в FAQ-е лежит 3 программы "Ханойские башни", это так, на всякий случай, для любителей вечно изобретать велосипеды...

Я не любитель изобретать велосипед, но когда темы к курсовым работам всегда одни и теже деваться не куда, а если брать чье-то решение не всегда оканчивается хорошо
Гораздо приятнее сделать что-то самому, чем брать уже готовое решение
Будет 4-ый экземпляр, что в этом плохого?

и проблема вот в этом

принажамтии клавиши вверх "а" присваевается знаяение элемента матрици вот тут то и проблема, привыборе второго столбца, в нем все элементы "0", "а" присваевается значение 10, привыборе третьего столбца "а" присваевается значение 3 откуда эти значения беруться я вообще понять не могу
помогите пожалуйста разобраться в принципе из за этого графическое представление всего этого действия и остановилось

Сообщение отредактировано: Zveruga - 20.11.2007 10:22

Ничего особенно плохого, только просьба к тебе: выкладывай для других только тогда, когда будешь уверен, что программа не только выдает правильный результат, но и хорошо написана.

Для начала, несколько общих замечаний.

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

2. Используй оператор case, во многих случаях это проясняет программу. Например, твое:

         if (key='q') or (key='Q') then stop:=true;
         if (key='1') then j:=1;
         if (key='2') then j:=2;
         if (key='3') then j:=3;

- все можно заменить на такую конструкцию:

    case key of
      'q','Q': stop:=true;
      '1': j:=1;
      '2': j:=2;
      '3': j:=3;
    end;

3. Оператор repeat ... until сам по себе представляет операторные скобки, begin и end внутри него не нужны.

4. Вместо Stop=false рекомендую писать not Stop.

5. Выводи чуть больше пояснений. Когда прога останавливается молча - непонятно, что жать..

Теперь по твоей проблеме. В том блоке, который ты пытался выделить жирным (я исправил, никогда больше не делай так в программном тексте), есть явная ошибка. Ты проверяешь условие на элемент матрицы, но НЕ проверяешь индекс. Поэтому ты легко выскакиваешь за пределы массива. Если у тебя включена опция Range Check, то это приведет к ошибке, а если не включена - то к непредсказуемому поведению проги (что, как я понимаю, и случилось). Рекомендую держать Range Check включенным на этапе отладки.

Исправь и приноси новый вариант программы. Будем разбираться дальше .

а вот этот цикл как раз и предполагает, что в столбце найдётся хотя бы один положительный элемент

             repeat
              begin
                i:=i+1;
                a:=hb[i,j];
              end;
             until hb[i,j]>0;

Таких элементов нет, поэтому происходит выход за границы массива

Спасибо за ответы
Все замечания учел Вроде стало получаться. Действительно промаргал момент в цикле выбора значения при нажатии клавиши вверх
По поводу case, я так понял этот оператор можно использовать только для значищих клавиш на клавиатуре, а для клавиш управления его использовать нельзя.
Работаю дальше над программой

З.Ы. Прошу прощения за долгие ответы. Из за разници во времяни не могу быстро отвечать.

Почему же? Вот, например, самый простой вариант обработчика нажатий клавиш..

if KeyPressed then begin
  c:=ReadKey;
  case c of
    #0: begin
      c:=ReadKey;
      case c of
        #71: {Home};
        #72: {Up};
        #73: {PgUp};
        #75: {Left};
        #77: {Right};
        #79: {End};
        #80: {Down};
        #72: {PgDn};
        #59: {F1};
        else {wrong key};
      end
    end;
    #27: {Esc};
    #13: {Enter};
    ' ': {Space};
    'q','Q': {Quit};
    's','S': {Save};
    {...something else...}
    else {wrong key};
  end
end;

Прошу прощение за ДОООЛГИЙ ответ ну лучше поздно чем ни когда. Работа откладывает свой отпечаток Выставляю на суд код игры "Ханойская башня", как обещал
Может это не самый лучший вариант, но все таки сделал сам, но с вашей помощью! Спасибо всем кто откликнулся

program nb3;

uses crt, graph; {подключение модулей}

const
   G: FillPatternType = ($ff, $ff, $ff, $ff, $ff, $ff, $ff, $ff); {объявление типа закраски}

var
   hb:array[1..9,1..3] of integer; {Объявление двухмерного массива }
   i{строка}, j{столбец}, a{вспомогательная переменная для памяти значения элемента мас-сива}:integer; {формирование двухмерного массива}
   n, m, k, l, t, d:integer; {вспомогательные переменные}
   stop:boolean; {переменная флаг (true, false). Отвечает за выход из программы}
   top:integer; {вспомогательная переменная}
   key:char; {переменная для включении процедуры keypressed}
   grDriver, grMode, ErrCode:integer; {проверка графического режима}
   kurx1, kurx2, kury1, kury2:integer; {координаты курсора}
   g1:integer;{цвет окружности в залючительной части}
   x, y, x1, y1:integer; {координаты для формирования пирамиды}
   dx1, ddx1, dy1:integer {значения приращений для формирования пирамиды}
   remx1, remy1, remx2, remy2:integer; {координаты, используемые при перемещения диска}

procedure kursor (dx:integer); { рисует курсор и отвечает за его перемещение по экрану }
begin
{запоминаем координаты предыдущего положения курсора}
   kurx2:=kurx1;
   kury2:=kury1;
{устанавливаем значение новой координаты «X» курсора, «Y» не изменяется}
   kurx1:=kurx1+dx;
   SetFillPattern(G, 0); {устанавливаем стиль и цвет закраски курсора}
   bar (kurx2,kury2,kurx2+5,kury2-5); {стираем курсор со старыми координатами}
   SetFillPattern(G, 14); {устанавливаем стиль и цвет закраски курсора}
   bar (kurx1,kury1,kurx1+5,kury1-5); {рисуем курсор с новыми координатами}
   dx:=0;
end;

procedure remdisk(rem,dremx:integer); {запоминает взятый диск с позиции и отвечает за перемещение диска по экрану вместе с курсором}
begin
   if a=0 then rem:=0; {проверка наличия диска (переменная «а» хранит в себе значение эле-мента массива)}
{запоминаем координаты предыдущего положения диска}
   remx2:=remx1;
   remy2:=remy1;
{устанавливаем значение новой координаты «X» курсора, «Y» при перемещении вдоль оси «Х» не изменяется}
   remx1:=remx1+dremx;
   ddx1:=ddx1*d;
   setfillpattern(G,0); {устанавливаем стиль и цвет закраски диска}
   bar(remx2-ddx1,remy2,remx2+ddx1,remy2+9); {стираем диск со старыми координатами}
   setfillpattern(G,rem); {устанавливаем стиль и цвет закраски диска}
   bar(remx1-ddx1,remy1,remx1+ddx1,remy1+9); {рисуем диск с новыми координатами}
   ddx1:=5;
end;

procedure disk (x1,cvet:integer); {рисует диски согласно получаемой матрицы и выводит на экран оформление игры}
begin
   dy1:=dy1*i; {координата }
   ddx1:=ddx1*d; {размер диска зависит от значения элемента массива}
   SetFillPattern(G, cvet); {устанавливаем стиль закраски и цвет диска, зависящий от значе-ния элемента массива}
   bar(x1-ddx1,y1+dy1,x1+ddx1,y1+9+dy1);
   if i=m then {вывод на экран оформления игры}
      begin
         setcolor(11); {устанавливаем текущий цвет}
         line(1,y1+9+dy1,640,y1+9+dy1); {рисуем линию текущим цветом}
   {выводим текст на экран текущим цветом}
         outtextxy(115,y1+20+dy1,'1'); 
         outtextxy(315,y1+20+dy1,'2');
         outtextxy(515,y1+20+dy1,'3');
         outtextxy(20,y1+30+dy1,'UP - to take disk');
         outtextxy(20,y1+40+dy1,'DOWN - to put disk');
         outtextxy(200,y1+30+dy1,'LEFT - to the cursor the left');
         outtextxy(200,y1+40+dy1,'RIGHT - to the cursor the right');
         outtextxy(480,y1+30+dy1,'Q - output');
         outtextxy(480,y1+40+dy1,'Enter - begin game')
      end;
{возвращаем первоначальные значения приращениям и координатам}
   dy1:=10;
   ddx1:=5;
   x1:=115;
   y1:=150;
end;

procedure test (d1:integer); { проверяет положение курсора и присваивает элементу массива соответствующее значение столбца }
begin 
{если координата курсора «Х» имеет значение 115, то заполняем в массиве 1-ый столбец}
   if d1=115 then
      begin
         x1:=115;
         j:=1;
      end;
{если координата курсора «Х» имеет значение 315, то заполняем в массиве 2-ой столбец}
   if d1=315 then
      begin
         x1:=315;
         j:=2;
      end;
{если координата курсора «Х» имеет значение 515, то заполняем в массиве 3-ий столбец}
   if d1=515 then
      begin
         x1:=515;
         j:=3;
      end;
end;

procedure theend; {анимация заключительной части}
begin
   cleardevice; {очищаем экран}
   repeat
      x:=random(640); {случайный выбор координаты «Х» от 1 до 640}
      y:=random(480); {случайный выбор координаты «Y» от 1 до 480}
      g1:=random(15); {случайный выбор цвета}
      setcolor(g1); {устанавливаем текущий цвет}
      circle(x,y,g1); {рисуем окружность текущим цветом}
      SetTextStyle(DefaultFont, HorizDir, 2); {устанавливаем стиль и размер шрифта}
      outtextxy(130,200,'Game Over Press eny key'); {выводим текст на экран}
   until keypressed; {нажатие любой клавиши закрывает игру}
   stop:=true;
end;

procedure up; {поднимает диск к курсору}
begin
   if a=0 then {если переменная «а» (отвечает взят ли диск) не занята, то берем диск}
      begin
          i:=0; {присваеваем «i» значение 0}
          repeat
             i:=i+1;
             a:=hb[i,j]; {присваиваем «а» значение элемента массива}
             d:=hb[i,j]; {присваиваем «d» значение элемента массива}
          until (hb[i,j]>0) or (i=m); {выполнять цикл пока значение элемента массива не станет больше 0 или значение строки массива не станет равно количеству дисков}
          disk (x1,0); {рисуем новую пирамиду}
          hb[i,j]:=0; {присваиваем взятому элементу массива значение 0}
          remdisk(d,0); {запоминаем диск}
   {закрашиваем «NO» после неверного хода}
          SetFillPattern(G, 0);
          bar (100,1,120,11);
      end;
end;

procedure down; {опускает диск на на текущее положение курсора и проверяет правиль-ность хода  согласно правил игры «Ханойская башня»}
begin
   i:=0; {присваиваем «i» значение 0}
     repeat
        i:=i+1; {ищем значение элемента массива больше 0 или пока строка массива не будет равна количеству дисков }
     until (hb[i,j]>0) or (i=m);
     if hb[i,j]=0 then {если значение элемента массива равно 0, то }
        begin
           hb[i,j]:=a; {присваиваем элементу массива значение «а»}
           d:=hb[i,j]; {«d» присваиваем значение элемента массива}
           a:=0; {обнуляем значение переменной «а»}
           disk(x1,d); {рисуем диск}
           remdisk(0,0); {обнуляем память диска}
{закрашиваем «NO» после неверного хода}
           SetFillPattern(G, 0);
           bar (100,1,120,11);
        end
     else
        begin
{проверка правил игры если значение взятого элемента массива больше текущего значения в соответствующем столбце, то выводим на экран слово «NO»}
           if (a>=hb[i,j]) or (a=0) then  outtextxy(100,1,'NO') 
           else {иначе}
             begin
                i:=i-1; {присваиваем значению строки массива значение меньше на 1}
                hb[i,j]:=a; {присваиваем элементу массива значение «а»}
                d:=hb[i,j]; {«d» присваиваем значение элемента массива}
                a:=0; {обнуляем значение переменной «а»}
                disk(x1,d); {рисуем диск}
                remdisk(0,0); {обнуляем память диска}
{закрашиваем «NO» после неверного хода}
                SetFillPattern(G, 0);
                bar (100,1,120,11);
             end;
        end;
    if hb[1,3]=1 then theend(0); {если элемент массива в первой строке третьего столбца при-нимает значение 1, то конец игры}
end;

begin
   clrscr; {очистка экрана}
   randomize; {включаем генератор случайных чисел}
{приветствие и объяснение правил игры}
   writeln('Игра Ханойская башня!!! ');
   writeln('Правила игры: ');
   writeln('необходимо переставить диски с позиции 1 в позицию 3 ');
   writeln('Условие!!! Нельзя ставить больший диск на меньший');
{ввод входных данных}
   repeat
      write('Введите количестов дисков (от 1 до 9) ');
      readln(m);
{присвоение начальных значений переменным}
   until (m>=1) and (m<=9) ;
   l:=1;
   k:=1;
   n:=3;
   a:=0;
   ddx1:=5;
   dy1:=10;
{проверка графического режима}
  grDriver:=Detect;
 InitGraph(grDriver, grMode, 'c:\bp\bgi');
  ClearDevice;
{присвоение начальных координат}
  kurx1:=115; 
  kury1:=108;
  kursor (0);
  remx1:=117;
  remy1:=115;
  x1:=115;
  y1:=150;
  for i:=1 to m do {формирование двухмерного массива и вывод на экран пирамиды и графи-ческого оформления}
  begin
     for j:=1 to n do
        begin
           hb[i,j]:=k;
           k:=0;
           d:=hb[i,j];
           if hb[i,j]>0 then disk (x1,d);
        end;
     l:=l+1;
     k:=k+l;
     writeln;
  end;
test (kurx1);
   outtextxy(250,1,'Game HanoiTower');
   outtextxy(265,11,'Press Enter'); {начало игры}
  repeat
     if keypressed then key:=readkey; {вход/выход из программы}
     case key of
          #13: begin top:=1; SetFillPattern(G, 0); bar (265,11,365,21); end;
          'q','Q':top:=2; 
     end;
     until (top=1) or (top=2);
     if top=1 then stop:=false;
     if top=2 then stop:=true;
     while not stop do
     if keypressed then begin {блок управления}
     key:=readkey;
     case key of
         'q','Q': stop:=true; {если нажата клавиша «q» или «Q», то выход из программы}
         #72: up; {клавиша стрелка вверх, вызов процедуры up}
         #80: down; {клавиша стрелка вниз, вызов процедуры down}
         #75: 
           begin {клавиша стрелка влево, вызов процедур remdisk, kursor, test}
            if (kurx1>120) then
                begin
                   kursor (-200);
                   test (kurx1);
                   remdisk(d,-200);
{закрашиваем «NO» после неверного хода}
                   SetFillPattern(G, 0);
                   bar (100,1,120,11);
               end;
           end;
         #77: 
           begin {клавиша стрелка вправо, вызов процедур remdisk, kursor, test}
            if (kurx1<400) then
                begin
                   kursor (200);
                   test (kurx1);
                   remdisk(d,200);
{закрашиваем «NO» после неверного хода}
                   SetFillPattern(G, 0);
                   bar (100,1,120,11);
                end;
           end;
  end;
end;
theend;
closegraph;
end.

P.S. За курсовик получил оценку хорошо