Технический форум
Вернуться   Технический форум > Программирование > Форум программистов > Delphi, Kylix and Pascal


Ответ
 
Опции темы Опции просмотра
Старый 15.10.2013, 22:30   #1 (permalink)
Мариночка
Новичок
 
Регистрация: 05.06.2013
Сообщений: 2
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
По умолчанию Ход ферзя

Здравствуйте. Не могу разобраться с программой. Необходим поворот на 180 градусов, у меня на 90. как исправить?
Код программы:
program Project6;

{$APPTYPE CONSOLE}

uses
SysUtils,
Windows;

const n=8;

type pointer=^node;
node=record
info,pair:array [1..n] of integer;
nextointer;
end;

var f:_COORD;
i,j:integer;
x:array [1..n] of integer;
a:array [1..n] of boolean;
b:array [2..n+n] of boolean;
c:array [1-n..n-1] of boolean;
s,q,hointer;
flag:boolean;
ConHandle: THandle;

function maseq(a,b:array of integer):boolean;
begin
maseq:=true;
j:=1;
for i:=n downto 1 do
if x[i]<>q.info[j] then begin
maseq:=false;
Break;
end
else j:=j+1;
end;


procedure save(var sointer);
begin
if s=nil then begin
new(s);
for i:=1 to n do s.info[i]:=x[i];
end
else begin
q:=s;
if q.next=nil then begin
new(h);
q.next:=h;
h.next:=nil;
for i:=1 to n do h.info[i]:=x[i];
end
else
while q.next<>nil do begin
if maseq(q.info[i],x[i]) then begin
for i:=1 to n do q.pair[i]:=x[i];
flag:=false;
break;
end
else flag:=true;
q:=q.next;
end;
if maseq(q.info[i],x[i]) then for i:=1 to n do q.pair[i]:=x[i];
if flag=true then begin
new(h);
q.next:=h;
h.next:=nil;
for i:=1 to n do h.info[i]:=x[i];
end;
end;
end;

procedure writecol(i,j:integer; s:string);
var TC:word;
begin
if odd(i+j) then tc:=0+7*16
else tc:=7+0*16;
SetConsoleTextAttribute(ConHandle,tc);
write(s,' ');
end;


procedure print(hointer);
var k,r:integer;
begin
r:=1;
While (h.next<>nil) do begin
for i:=1 to n do begin
j:=h.info[i];
for k:=1 to j-1 do writecol(i,k,' ');
k:=j;
writecol(i,k,'X ');
for k:=j+1 to n do writecol(i,k,' ');
SetConsoleTextAttribute(ConHandle,7+0*16);
if i=1 then write(' ','Para',r,' ')
else if r>9 then write(' ')
else write(' ');
j:=h.pair[i];
for k:=1 to j-1 do writecol(i,k,' ');
k:=j;
writecol(i,k,'X ');
for k:=j+1 to n do writecol(i,k,' ');
writeln;
end;
r:=r+1;
h:=h.next;
writeln(#10);
end;
end;


procedure ferz(i:integer);
var j:integer;
begin
for j:=1 to 8 do
if a[j] and b[i+j] and c[i-j] then begin
x[i]:=j;
a[j]:=false;
b[i+j]:=false;
c[i-j]:=false;
if i<n then ferz(i+1)
else save(s);
a[j]:=true;
b[i+j]:=true;
c[i-j]:=true;
end;
end;

begin
ConHandle := GetStdHandle( STD_OUTPUT_HANDLE );
f.X:=1200;
f.Y:=1200;
SetConsoleScreenBufferSize(ConHandle,f);
for i:=1 to n do a[i]:=true;
for i:=2 to n+n do b[i]:=true;
for i:=1-n to n-1 do c[i]:=true;
ferz(1);
q:=s;
print(q);
readln;
end.
Мариночка вне форума   Ответить с цитированием

Старый 15.10.2013, 22:30
Helpmaster
Member
 
Аватар для Helpmaster
 
Регистрация: 08.03.2016
Сообщений: 0

Если хотите побыстрее решить проблему - полистайте аналогичные темы

Ход ферзя. Pascal

Ads

Яндекс

Member
 
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
Ответ


Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Выкл.
HTML код Выкл.
Trackbacks are Вкл.
Pingbacks are Вкл.
Refbacks are Выкл.




Часовой пояс GMT +4, время: 06:25.

Powered by vBulletin® Version 6.2.5.
Copyright ©2000 - 2014, Jelsoft Enterprises Ltd.