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

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

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

> Ханойские башни, с использованием графики
сообщение
Сообщение #1


Гость






см. Ханойские башни ( http://forum.pascal.net.ru/index.php?showtopic=9254 )
(сообщение отредактировал Altair)

Здрасте,
мне бы програмку,
Ханойские башни, с графикой. Наверно это большая программа-считай игра получается, но может кто уже делал чтото подобное?

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

вот такой код нашла в вашем топике про рекурию, не рекурсивное решение было тоже, но мне я думаю рекурсивное подойдет больше?,может это както поможет?

Код
Program Hanoj;
Const k = 3;
Var a,b,c : Char;
Procedure Disk(n : Integer; a, b, c: Char);
Begin
if n>0 then
    begin
      Disk(n-1,a,c,b);
      Writeln(‘Диск ‘,n, ’ c ‘, a,’->’, b);
      Disk(n-1,c,b,a);
    end;
End;
BEGIN
a := ‘A’; b := ‘B’; c := ‘C’;
Disk(k,a,b,c);
ReadLn;
END.

если возможно напишите полное решение (максимално простое-примитивное), если нет, то любая помошь приветствуется
заранее благодарна
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов(1 - 1)
сообщение
Сообщение #2


Бывалый
***

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

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


как то недавно нашла в инете. чье - не смогу сказать. работает или нет не проверяла.

попробуй. smile.gif

Код
uses crt,graph;
type
  nodeptr=^node;
       node=record
       no:integer;
       next:nodeptr;
  end;
  aray20=array[1..20]of byte;
var
  yeni,top1,top2,top3,temp1,temp2,temp3:nodeptr;
  n,i,tekcift,son,control,sayac1,sayac2,sayac3:byte;
  source,dest:char;
  counter,deger:longint;
  uzun1,uzun2,uzun3:aray20;
  gd,gm :integer;
  cevir:string;
{-------------------------------------------------------}
Procedure Initialize;
begin
  clrscr;
  top1:=nil; top2:=nil; top3:=nil;
  tekcift:=0; counter:=1; control:=0;  sayac1:=1; sayac2:=1; sayac3:=1;

    gotoxy(25,2); textcolor(red); write('HANOI TOWERS');
    gotoxy(1,4); textcolor(white);
    writeln('   There are 3 pegs named A,B,C. One peg is source peg,');
    writeln('one is destination peg, the other peg is temporary peg.');writeln;
    writeln('   There are N discs. The smallest disc is disc1 and the ');
    writeln('largest disc is disc N. There can be maximum 20 discs.');textcolor(red);writeln;
      write('   GOAL  : ');textcolor(white);
    writeln('All discs will be carried from source peg into');
    writeln('           the destination peg.'); writeln;textcolor(red);
      write('   RULES : 1) ');textcolor(white);
    writeln('Only one disc can be moved at a time, and');
    writeln('              this disc must be the top disc on a peg.');textcolor(red);writeln;
      write('           2) ');textcolor(white);
      writeln('A larger disc can never be placed on top');
      writeln('              of a smaller disc.');writeln;
      writeln('          IT IS NOT A RECURSIVE PROGRAM');writeln;
      writeln('           Press any key to continue');
    readkey;clrscr;
    repeat
    write('Enter the N number          : ');readln(n);
    if (n=0)or(n=1)or(n>20) then clrscr;
  until (n<>0)and(n<>1)and(n<=20);

  write('Enter the source peg(A,B,C) : ');readln(source);
  source:=upcase(source);
  repeat
   write('Enter the destination peg   : ');readln(dest);
   source:=upcase(source); dest:=upcase(dest);
   if dest=source then begin gotoxy(28,3); clreol; gotoxy(1,3);end;
  until dest<>source;
  detectgraph(gd,gm);
  initgraph(gd,gm,'');
  cleardevice;
  setbkcolor(7);
end;
{----------------------------------------------------------}
Procedure Push(item:integer; var head:nodeptr);
begin
  new(yeni);         yeni^.no:=item;
  yeni^.next:=head;  head:=yeni;
end;
{-----------------------------------------------------------}
Function Pop(var head:nodeptr):integer;
var
temp:nodeptr;
begin
  temp:=head;       head:=head^.next;
  pop:=temp^.no;  dispose(temp);
end;
{-----------------------------------------------------------}
Function usalma(a:integer):integer;
var i,s:integer;
begin
  s:=1;
  if a=1 then s:=2
         else for i:=1 to n do s:=s*2;
  usalma:=s-1;
end;
{-----------------------------------------------------------}
Function tekmi(a:integer):byte;
begin
if a mod 2=1 then tekmi:=1
             else tekmi:=2;
end;
{-----------------------------------------------------------}
Procedure ciz(s1,s2,s3:aray20; sa1,sa2,sa3:byte);
var i,m1,m2,m3:byte;
begin
  setfillstyle(1,red);   m1:=0; m2:=0; m3:=0;
  setcolor(1);
  outtextxy(95,325,'A'); outtextxy(295,325,'B'); outtextxy(495,325,'C');
  setcolor(red);
  outtextxy(295,370,'Press any key to continue');
  setcolor(yellow);
  for i:=sa1-1 downto 1 do
               begin
                 m1:=m1+1; str(s1[i],cevir);
                 bar(85-4*s1[i],313-13*m1,109+4*s1[i],323-13*m1);
                 outtextxy(95,313-13*m1,cevir);
               end;

  for i:=sa2-1 downto 1 do
               begin
                 m2:=m2+1; str(s2[i],cevir);
                 bar(85-4*s2[i]+200,313-13*m2,309+4*s2[i],323-13*m2);
                 outtextxy(295,313-13*m2,cevir);
               end;

  for i:=sa3-1 downto 1 do
               begin
                 m3:=m3+1; str(s3[i],cevir);
                 bar(85-4*s3[i]+400,313-13*m3,509+4*s3[i],323-13*m3);
                 outtextxy(495,313-13*m3,cevir);
               end;
setcolor(red);
end;
{----------------------------------------------------------}
Procedure yazdir;
var i:byte;
begin
  cleardevice;
  sayac1:=1; sayac2:=1; sayac3:=1;
  temp1:=top1; temp2:=top2; temp3:=top3;

  while temp1<>nil do begin
  uzun1[sayac1]:=temp1^.no;
  temp1:=temp1^.next; sayac1:=sayac1+1;
  end;

  while temp2<>nil do begin
  uzun2[sayac2]:=temp2^.no;
  temp2:=temp2^.next; sayac2:=sayac2+1;
  end;

  while temp3<>nil do begin
  uzun3[sayac3]:=temp3^.no;
  temp3:=temp3^.next; sayac3:=sayac3+1;
  end;

  if (source='A')and(dest='C') then ciz(uzun1,uzun2,uzun3,sayac1,sayac2,sayac3);
  if (source='A')and(dest='B') then ciz(uzun1,uzun3,uzun2,sayac1,sayac3,sayac2);
  if (source='B')and(dest='C') then ciz(uzun2,uzun1,uzun3,sayac2,sayac1,sayac3);
  if (source='B')and(dest='A') then ciz(uzun3,uzun1,uzun2,sayac3,sayac1,sayac2);
  if (source='C')and(dest='A') then ciz(uzun3,uzun2,uzun1,sayac3,sayac2,sayac1);
  if (source='C')and(dest='B') then ciz(uzun2,uzun3,uzun1,sayac2,sayac3,sayac1);
end;
{-----------------------------------------------------------}
begin
  initialize;

  for i:=n downto 1 do push(i,top1); yazdir;
  readkey;

  if tekmi(n)=1 then begin
                       if tekmi(top1^.no)=1 then push(pop(top1),top3)
                                            else push(pop(top1),top2);
                     end
                else begin
                       if tekmi(top1^.no)=1 then push(pop(top1),top2)
                                            else push(pop(top1),top3);
                     end;

  son:=1; yazdir;
  outtextxy(20,370,'Number of move : 1');
  readkey;
  deger:=usalma(n);

  if tekmi(n)=1 then begin

    repeat

      if (top1<>nil)and(top1^.no<>son) then
         begin
           if (tekmi(top1^.no)=1)and(top1^.no<top3^.no) then
              begin
                son:=top1^.no;  str(son,cevir);
                Push(pop(top1),top3); control:=10;
                yazdir;
              end;
           if (tekmi(top1^.no)=2)and(top1^.no<top2^.no)and(control=0) then
              begin
                son:=top1^.no; str(son,cevir);
                Push(pop(top1),top2); control:=10;
                yazdir;
              end;
         end;


      if (top2<>nil)and(top2^.no<>son)and(control=0) then
         begin
           if (tekmi(top2^.no)=1)and(top2^.no<top1^.no) then
              begin
                son:=top2^.no;   str(son,cevir);
                Push(pop(top2),top1); control:=10;
                yazdir;
              end;
           if (tekmi(top2^.no)=2)and(top2^.no<top3^.no)and(control=0) then
              begin
                son:=top2^.no;    str(son,cevir);
                Push(pop(top2),top3); control:=10;
                yazdir;
              end;
         end;


      if (top3<>nil)and(top3^.no<>son)and(control=0) then
         begin
           if (tekmi(top3^.no)=1)and(top3^.no<top2^.no) then
              begin
                son:=top3^.no;  str(son,cevir);
                Push(pop(top3),top2); control:=10;
                yazdir;
              end;
           if (tekmi(top3^.no)=2)and(top3^.no<top1^.no)and(control=0) then
              begin
                son:=top3^.no;  str(son,cevir);
                Push(pop(top3),top1); control:=10;
                yazdir;
              end;
         end;
      control:=0;
      counter:=counter+1;
      str(counter,cevir);
      outtextxy(20,370,'Number of move :');outtextxy(150,370,cevir);
      readkey;
      until deger=counter;
                     end;


  if tekmi(n)=2 then begin
    repeat
      if (top1<>nil)and(top1^.no<>son) then
         begin
           if (tekmi(top1^.no)=1)and(top1^.no<top2^.no) then
              begin
                son:=top1^.no;  str(son,cevir);
                Push(pop(top1),top2); control:=10;
                yazdir;
              end;
           if (tekmi(top1^.no)=2)and(top1^.no<top3^.no)and(control=0) then
              begin
                son:=top1^.no;  str(son,cevir);
                Push(pop(top1),top3); control:=10;
                yazdir;
              end;
         end;


      if (top2<>nil)and(top2^.no<>son)and(control=0) then
         begin
           if (tekmi(top2^.no)=1)and(top2^.no<top3^.no) then
              begin
                son:=top2^.no;  str(son,cevir);
                Push(pop(top2),top3); control:=10;
                yazdir;
              end;
           if (tekmi(top2^.no)=2)and(top2^.no<top1^.no)and(control=0) then
              begin
                son:=top2^.no;  str(son,cevir);
                Push(pop(top2),top1); control:=10;
                yazdir;
              end;
         end;


      if (top3<>nil)and(top3^.no<>son)and(control=0) then
         begin
           if (tekmi(top3^.no)=1)and(top3^.no<top1^.no) then
              begin
                son:=top3^.no;  str(son,cevir);
                Push(pop(top3),top1); control:=10;
                yazdir;
              end;
           if (tekmi(top3^.no)=2)and(top3^.no<top2^.no)and(control=0) then
              begin
                son:=top3^.no;  str(son,cevir);
                Push(pop(top3),top2); control:=10;
                yazdir;
              end;
         end;
      control:=0;
      counter:=counter+1;
      str(counter,cevir);
      outtextxy(20,350,'Number of move :');outtextxy(150,350,cevir);
      readkey;
      until deger=counter;
                     end;
end.


см. Ханойские башни ( http://forum.pascal.net.ru/index.php?showtopic=9254 )

Сообщение отредактировано: Altair -


--------------------
непонимающая..
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 





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