Vezérek elhelyezése a sakktáblán Backtrack algoritmussal

Írjunk programot, mely a Backtrack algoritmus segítségével ütésmentesen elhelyez 8 vezért a sakktáblán. Nem kell az összes megoldást megkeresnie, ellenben minden ’a’ oszlopban elhelyezett vezérhez keressen egy-egy megoldást (azaz nyolcat).

A program indulási képe:

A megtalált nyolc lehetséges elrendezés (a sakktáblán az utolsóként megtalált felállás látható):

A program listája:

unit UBTrVezer;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes,

Graphics, Controls, Forms, Dialogs, StdCtrls, Grids;

Const Max=8;

type
TfmBTrVezer = class(TForm)
lbBTrVezer: TLabel;
btKilepes: TButton;
sgBTrVezer: TStringGrid;
sgTabla: TStringGrid;
btStart: TButton;
btAlap: TButton;
lbKesz: TLabel;
Function Rossz(B,C: Byte): Boolean;
Function Jo(A: Byte): Boolean;
Procedure Keres;
procedure btKilepesClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure sgTablaDrawCell(Sender: TObject; Col, Row: Integer;
Rect: TRect; State: TGridDrawState);
procedure btStartClick(Sender: TObject);
procedure btAlapClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
fmBTrVezer: TfmBTrVezer;
ACol, ARow: Integer;
  N: Word;
  T: Array[1..Max] Of Byte;
  I: Word;

implementation

{$R *.dfm}

procedure TfmBTrVezer.btKilepesClick(Sender: TObject);
begin
Close;
end;

procedure TfmBTrVezer.sgTablaDrawCell(Sender: TObject; Col, Row: Integer;
Rect: TRect; State: TGridDrawState);
begin
With sgTabla.Canvas.Brush Do
Begin
{rögzített cellák}
If gdFixed In State Then Color:=clWhite;

{kiválasztott cella}
If gdSelected In State Then Color:= clSilver;

{a táblázat belseje}
If Not((gdSelected In State) Or (gdFixed In State)) Then
Case Odd(Col) XOr Odd(Row) Of
False: Color:= clWindow;
True: Color:= clSilver;
End;
sgTabla.Canvas.Font.Size:= 17;
End;
{szöveg beállítása rácson belül: +6 +4}
{kövér betüket akkor tud, ha DefaultDrawing=True}
sgTabla.Canvas.TextRect(Rect,Rect.Left+16,Rect.Top+4,sgTabla.Cells[Col,Row]);
If gdFocused In State Then sgTabla.Canvas.DrawFocusRect(Rect);
end;

procedure TfmBTrVezer.FormCreate(Sender: TObject);
Var I: Word;
Ch: Char;
begin
With sgBTrVezer Do
For I:= 1 To Max Do
Begin
Cells[I,0]:= IntToStr(I)+'.';
Cells[0,I]:= IntToStr(I)+'.';
End;

With sgTabla Do
Begin
ColWidths[9]:= 0;
RowHeights[9]:= 0;
For I:= 1 To 8 Do Cells[0,I]:= IntToStr(9-I);
For Ch:= 'a' To 'h' Do Cells[Ord(Ch)-96,0]:= Ch;
    Col:= 9; Row:= 9;
End;
  N:= 0;
lbKesz.Caption:= '';
end;

procedure TfmBTrVezer.btAlapClick(Sender: TObject);
Var I, J: Word;
begin
For I:= 1 To Max Do T[I]:= 0;
For I:= 1 To Max Do For J:= 1 To Max Do
Begin
sgBTrVezer.Cells[I,J]:= '';
sgTabla.Cells[I,J]:= '';
End;
  N:= 0;
lbKesz.Caption:= '';
end;

Function TfmBTrVezer.Rossz(B,C: Byte): Boolean;
Var J: Word;
Begin
  J:= 1; While (J<B) And (C<>T[J]) And (Abs(C-T[J])<>Abs(B-J)) Do Inc(J);
  Rossz:= Not(J<B);
End;

Function TfmBTrVezer.Jo(A: Byte): Boolean;
Label 1;
Begin
Repeat
    Inc(T[I]);
If T[I]>8 Then GoTo 1;
Until (T[I]<=8) And Rossz(A,T[I]);
  1: Jo:= T[I]<=8;
End;

Procedure TfmBTrVezer.Keres;
Begin
  I:= 1;
With sgTabla Do While I In [1..8] Do If Jo(I) Then
Begin
Cells[I,Max-T[I]+1]:= 'V'; Inc(I); T[I]:= 0;
RePaint;
Sleep(50);
End
Else
Begin
Dec(I); Cells[I,Max-T[I]+1]:= '';
RePaint;
Sleep(50);
End;
End;

procedure TfmBTrVezer.btStartClick(Sender: TObject);
Var K, J, U, V: Word;
begin
For K:= 0 To 7 Do
Begin
For J:= 1 To 8 Do T[J]:= K;
For U:= 1 To Max Do For V:= 1 To Max Do sgTabla.Cells[U,V]:= '';
    Keres;
    Inc(N); For U:= 1 To Max Do sgBTrVezer.Cells[U,N]:= IntToStr(T[U]);
sgBTrVezer.Repaint;
Sleep(500);
End;
lbKesz.Caption:= 'Kész';
end;

end.