• Добро пожаловать на компьютерный форум Tehnari.ru. Здесь разбираемся с проблемами ПК и ноутбуков: Windows, драйверы, «железо», сборка и апгрейд, софт и безопасность. Форум работает много лет, сейчас он переехал на новый движок, но старые темы и аккаунты мы постарались сохранить максимально аккуратно.

    Форум не связан с магазинами и сервисами – мы ничего не продаём и не даём «рекламу под видом совета». Отвечают обычные участники и модераторы, которые следят за порядком и качеством подсказок.

    Если вы у нас впервые, загляните на страницу о проекте и правила – там коротко описано, как задать вопрос так, чтобы быстро получить ответ. Чтобы создавать темы и писать сообщения, сначала зарегистрируйтесь, а затем войдите под своим логином.

    Не знаете, с чего начать? Создайте тему с описанием проблемы – подскажем и при необходимости перенесём её в подходящий раздел.
    Задать вопрос Новые сообщения Как правильно спросить
    Если пришли по старой ссылке со старого Tehnari.ru – вы на нужном месте, просто продолжайте обсуждение.

Ход ферзя

Мариночка

Ученик
Регистрация
5 Июн 2013
Сообщения
2
Реакции
0
Баллы
0
Ход ферзя

Здравствуйте. Не могу разобраться с программой. Необходим поворот на 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<>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:=x;
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:=x;
end
else
while q.next<>nil do begin
if maseq(q.info,x) then begin
for i:=1 to n do q.pair:=x;
flag:=false;
break;
end
else flag:=true;
q:=q.next;
end;
if maseq(q.info,x) then for i:=1 to n do q.pair:=x;
if flag=true then begin
new(h);
q.next:=h;
h.next:=nil;
for i:=1 to n do h.info:=x;
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;
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;
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:=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:=true;
for i:=2 to n+n do b:=true;
for i:=1-n to n-1 do c:=true;
ferz(1);
q:=s;
print(q);
readln;
end.
 
Назад
Сверху