KLENINA_queen

//link https://yadi.sk/d/F8DalqfUIoDQ9w
{Дана шахматная доска 8х8, на которой стоят ферзи, каждый ферзь может бить по вертикали
горизонтали и диагоналям,
нужно перебрать максимальное количество вариантов не бьющих друг друга ферзей.
каждая вертиакаль пронумерована от 1 до 8
и на каждой вертикали, горизонтали и диагонали }
{флажок в false, как попадется одинаковый, то true(while)}

program fn;

uses
  graphabc;

var
  a1: array of byte := (1, 1, 1, 1, 1, 1, 1, 1, 1);
  mm3, mm4: array[1..8] of byte;
  m: array[1..100] of array [1..100] of integer;    // Из программы закраска матрицы                                        // Из программы закраска матрицы
  i,  j, ax, ay, ymax, xmax: integer;// Из программы закраска матрицы

procedure fill(x, y: integer);// Процедура из программы закраска матрицы
var
  x1, x2, y1, y2, r: integer;
begin
  begin
    if (x >= 1) and (y >= 1) and (x <= xmax) and (y <= ymax) then
    begin
      x1 := ay * y;
      y1 := ax * x;
      x2 := x1 + ax;
      y2 := y1 + ay;
      if m[x, y] = 1 then
      begin
        setbrushcolor(clblack);
        Rectangle(x1, y1, x2, y2);
      end;
      if m[x, y] = 0 then
      begin
        setbrushcolor(clwhite);
        Rectangle(x1, y1, x2, y2);
      end;
      if m[x, y] = 2 then
      begin
        if (x mod 2 = 0) and (y mod 2 = 1) then
        begin
          setbrushcolor(clblack);
          Rectangle(x1, y1, x2, y2);
        end;
        if (x mod 2 = 1) and (x mod y = 0) then
        begin
          setbrushcolor(clblack);
          Rectangle(x1, y1, x2, y2);
        end;
        if (x mod 2 = 1) and (y mod 2 = 1) then
        begin
          setbrushcolor(clwhite);
          Rectangle(x1, y1, x2, y2);
        end;
        if (x mod 2 = 0) and (y mod 2 = 0) then
        begin
          setbrushcolor(clwhite);
          Rectangle(x1, y1, x2, y2);
        end;
        setbrushcolor(clblack);
        if ((x mod 2 = 1) and (y mod 2 = 1) or (x mod 2 = 0) and (y mod 2 = 0)) then
        begin
          setbrushcolor(clblack);
          for r := 1 to 7 do
            line(x1 + 5 + 1 + 5, y1 + 52 - r, x2 - 5 - 1 - 5, y1 + 52 - r, clblack);
          for r := 1 to 2 do
            line(x1 + 5 + 5, y1 + 46 - r, x2 - 5 - 5, y1 + 46 - r, clblack);
          for r := 1 to 2 do
            line(x1 + 4 + 5, y1 + 44 - r, x2 - 4 - 5, y1 + 44 - r, clblack);
          //1 слева корона
          for r := 1 to 4 do
            line(x1 + 10 + r, y1 + 42, x1 + 7, y1 + 28, clblack);
          circle(x1 + 7, y1 + 28, 3);
          //2
          for r := 1 to 5 do
            line(x1 + 18 + r, y1 + 41, x1 + 5 + 9 + 4, y1 + 20, clblack);
          circle(x1 + 5 + 9 + 4, y1 + 17, 3);
          //3
          for r := 1 to 4 do
            line(x2 - 10 - r, y1 + 42, x2 - 7, y1 + 28, clblack);
          circle(x2 - 5 - 2, y1 + 28, 3);
          //4
          for r := 1 to 5 do
            line(x2 - 18 - r, y1 + 41, x2 - 5 - 9 - 4, y1 + 20, clblack);
          circle(x2 - 5 - 9 - 4, y1 + 17, 3);
          //5
          for r := 1 to 3 do
            line(x2 - 30 - r, y1 + 41, x2 - 30, y1 + 10, clblack);
          for r := 0 to 3 do
            line(x2 - 30 + r, y1 + 41, x2 - 30, y1 + 10, clblack);
          circle(x2 - 30, y1 + 7, 3);
        end
        else
        begin
          setbrushcolor(clwhite);
          for r := 1 to 7 do
            line(x1 + 5 + 1 + 5, y1 + 52 - r, x2 - 5 - 1 - 5, y1 + 52 - r, clwhite);
          for r := 1 to 2 do
            line(x1 + 5 + 5, y1 + 46 - r, x2 - 5 - 5, y1 + 46 - r, clwhite);
          for r := 1 to 2 do
            line(x1 + 4 + 5, y1 + 44 - r, x2 - 4 - 5, y1 + 44 - r, clwhite);
          //1 слева корона
          for r := 1 to 4 do
            line(x1 + 10 + r, y1 + 42, x1 + 7, y1 + 28, clwhite);
          circle(x1 + 7, y1 + 28, 3);
          //2
          for r := 1 to 5 do
            line(x1 + 18 + r, y1 + 41, x1 + 5 + 9 + 4, y1 + 20, clwhite);
          circle(x1 + 5 + 9 + 4, y1 + 17, 3);
          //3
          for r := 1 to 4 do
            line(x2 - 10 - r, y1 + 42, x2 - 7, y1 + 28, clwhite);
          circle(x2 - 5 - 2, y1 + 28, 3);
          //4
          for r := 1 to 5 do
            line(x2 - 18 - r, y1 + 41, x2 - 5 - 9 - 4, y1 + 20, clwhite);
          circle(x2 - 5 - 9 - 4, y1 + 17, 3);
          //5
          for r := 1 to 3 do
            line(x2 - 30 - r, y1 + 41, x2 - 30, y1 + 10, clwhite);
          for r := 0 to 3 do
            line(x2 - 30 + r, y1 + 41, x2 - 30, y1 + 10, clwhite);
          circle(x2 - 30, y1 + 7, 3);
        end;
      end;
      if y < ymax then
      begin
        fill(x, y + 1);
      end;
      if (y = ymax) and (x < xmax) then
      begin
        fill(x + 1, y - y + 1);
      end;
    end;
  end;
end;

function prk(m1: array of byte): integer;
var
  ii, i4, i5, i6, i7, i8, hh: integer;
begin
  while (m1[8] <> 9) do
  begin
    if m1[8] < 8 then
    begin
      m1[8] := m1[8] + 1;
      hh := 1;
    end;
    if m1[8] = 8 then
      hh := 0;
    if (m1[8] = 8) and (m1[6] < 8) and (hh = 0) then
    begin
      m1[6] := m1[6] + 1;
      m1[8] := 1;
    end;
    if (m1[6] = 8) and (m1[8] = 8) and (m1[5] < 8)  then
    begin
      m1[5] := m1[5] + 1;
      m1[6] := 1;
      m1[8] := 1;
    end;
    if (m1[6] = 8) and (m1[8] = 8) and (m1[5] = 8) and (m1[4] < 8) then
    begin
      m1[4] := m1[4] + 1;
      m1[6] := 1;
      m1[8] := 1;
      m1[5] := 1;
    end;
    if (m1[6] = 8) and (m1[8] = 8) and (m1[5] = 8) and (m1[4] = 8) and (m1[3] < 8) then
    begin
      m1[3] := m1[3] + 1;
      m1[4] := 1;
      m1[6] := 1;
      m1[8] := 1;
      m1[5] := 1;
    end;
    if (m1[6] = 8) and (m1[8] = 8) and (m1[5] = 8) and (m1[4] = 8) and (m1[3] = 8) and (m1[2] < 8) then
    begin
      m1[2] := m1[2] + 1;
      m1[3] := 1;
      m1[4] := 1;
      m1[6] := 1;
      m1[8] := 1;
      m1[5] := 1;
    end;
    if (m1[6] = 8) and (m1[8] = 8) and (m1[5] = 8) and (m1[4] = 8) and (m1[3] = 8) and (m1[2] = 8) and (m1[1] < 8) then
    begin
      m1[1] := m1[1] + 1;
      m1[2] := 1;
      m1[3] := 1;
      m1[4] := 1;
      m1[6] := 1;
      m1[8] := 1;
      m1[5] := 1;
    end;
    if (m1[6] = 8) and (m1[8] = 8) and (m1[5] = 8) and (m1[4] = 8) and (m1[3] = 8) and (m1[1] = 8) and (m1[2] = 8) and (m1[1] < 8) then
    begin
      m1[1] := m1[1] + 1;
      m1[2] := 1;
      m1[3] := 1;
      m1[4] := 1;
      m1[6] := 1;
      m1[8] := 1;
      m1[5] := 1;
      m1[1] := 1;
    end;
    if (m1[6] = 8) and (m1[8] = 8) and (m1[5] = 8) and (m1[4] = 8) and (m1[3] = 8) and (m1[1] = 8) and (m1[2] = 8) and (m1[1] < 9) then
    begin
      m1[1] := m1[1] + 1;
      m1[2] := 1;
      m1[3] := 1;
      m1[4] := 1;
      m1[6] := 1;
      m1[8] := 1;
      m1[5] := 1;
      m1[1] := 1;
    end;
    i7 := 1;
    for i5 := 1 to 8 do
      for i6 := 1 to 8 do
      begin
        if i6 <> i5 then
          if (m1[i5] <> m1[i6]) and ((abs(m1[i6] - m1[i5]) <> abs(i6 - i5))) then
            i7 := i7 * 1
          else
            i7 := i7 * 0;
      end;
    ii := 1;
    if i7 = 1 then
    begin
      for i4 := 1 to 8 do
      begin
        if m1[1] <> 9 then
        begin
          if i4 = 8 then
            i8 := 1;
          if i4 = 7 then
            i8 := 2;
          if i4 = 6 then
            i8 := 3;
          if i4 = 5 then
            i8 := 4;
          if i4 = 4 then
            i8 := 5;
          if i4 = 3 then
            i8 := 6;
          if i4 = 2 then
            i8 := 7;
          if i4 = 1 then
            i8 := 8;

          mm3[ii] := m[m1[i8], i8];
          mm4[ii] := i8;
          m[m1[i8], i8] := 2;
          fill(i, j);
          ii := ii + 1;
        end;
      end;
      readln();
      for ii := 1 to 8 do
        m[m1[mm4[ii]], mm4[ii]] := mm3[ii];
    end;

  end;
end;

begin
  ax := 60;
  ay := 60;
  for i := 1 to 8 do
  begin
    for j := 1 to 8 do
    begin
      if (i mod 2 = 0) and (j mod 2 = 1) then
        m[i, j] := 1;
      if (i mod 2 = 1) and (j mod 2 = 0) then
        m[i, j] := 1;
    end;
  end;
  ymax := j;
  xmax := i;
  i := 1;
  j := 1;
  prk(a1);
end.