task5.2

unit MainW;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus, Vcl.StdCtrls,
  Vcl.Imaging.jpeg, Vcl.ExtCtrls;

type
  TMainWin = class(TForm)
    MainMenu: TMainMenu;
    BtnFind: TMenuItem;
    ImgField: TImage;
    BtnAbout: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure BtnFindClick(Sender: TObject);
    procedure BtnAboutClick(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
   TArrang = array [1..8] of Byte;

const
   TextAbout = 'Решение задачи о 8 ферзях. Нужно расставить на шахматной доске 8 ферзей так, чтобы они не били друг друга.';


var
   MainWin: TMainWin;
   AllArrangements: array of TArrang;
   CurrArrang: TArrang;
   CurrShownArrang: Integer;
   BmpQueenPic, BmpFieldPic: TBitMap;


implementation

{$R *.dfm}

function IsQueenFits(var A: TArrang; CurrVert, CurrHor: Byte): Boolean;
var
   i: Byte;
begin
   i := 1;
   while (i < CurrVert) and (CurrHor <> A[i]) and (Abs(CurrVert - i) <> Abs(CurrHor - A[i])) do
      Inc(i);
   IsQueenFits := i = CurrVert;
end;

procedure FindAllArrangements(CurrVert: Byte);
var
   i, CurrHor: Byte;
begin
   for CurrHor := 1 to 8 do
       if IsQueenFits(CurrArrang, CurrVert, CurrHor) then
         begin
            CurrArrang[CurrVert] := CurrHor;
            if CurrVert = 8 then
            begin
             SetLength(AllArrangements, Length(AllArrangements) + 1);
             AllArrangements[High(AllArrangements)] := CurrArrang;
            end;
            FindAllArrangements(CurrVert + 1);
         end;
end;

procedure DrawArrang(Num: Integer);
var
   tmpArrang: TArrang;
   i: Integer;
begin
   tmpArrang := AllArrangements[Num];
   for i := 1 to 8 do
      MainWin.ImgField.Canvas.Draw(62 * (i - 1), 62 * (tmpArrang[i] - 1) + 2, BmpQueenPic);
end;

procedure InitQueenPic;
var
   Path: string;
begin
   Path := ExtractFileDir(Application.ExeName);
   BmpQueenPic := TBitMap.Create;
   BmpQueenPic.LoadFromFile(path + '\img\queen.bmp');
   BmpQueenPic.Transparent := true;
   BmpFieldPic := TBitMap.Create;
   BmpFieldPic.LoadFromFile(path + '\img\field.bmp');
   BmpFieldPic.Transparent := true;
end;

procedure EraseField;
begin
   MainWin.ImgField.Canvas.Draw(0, 0, BmpFieldPic);
end;

procedure TMainWin.BtnAboutClick(Sender: TObject);
begin
   MessageBox(Handle, TextAbout, 'Информация', MB_OK);
end;

procedure TMainWin.BtnFindClick(Sender: TObject);
begin
   if CurrShownArrang < High(AllArrangements) then
      Inc(CurrShownArrang)
   else
      CurrShownArrang := 0;
   EraseField;
   DrawArrang(CurrShownArrang);

end;

procedure TMainWin.FormCreate(Sender: TObject);
begin
   FindAllArrangements(1);
   CurrShownArrang := -1;
   InitQueenPic;
end;

end.