Технический форум

Технический форум (http://www.tehnari.ru/)
-   Delphi, Kylix and Pascal (http://www.tehnari.ru/f43/)
-   -   Ход ферзя (http://www.tehnari.ru/f43/t91609/)

Мариночка 15.10.2013 22:30

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

{$APPTYPE CONSOLE}

uses
SysUtils,
Windows;

const n=8;

type pointer=^node;
node=record
info,pair:array [1..n] of integer;
next:pointer;
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,h:pointer;
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 s:pointer);
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(h:pointer);
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.


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

Powered by vBulletin® Version 4.5.3
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.