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

Írjunk programot, mely a Backtrack algoritmus segítségével megkeresi az összes lehetséges ütésmentes vezérelhelyezést a sakktáblán. A sakktábla méretét beviteli mező segítségével lehessen megadni (1-20 értékhatárok között). A keresés eredményét egy StrigGridben helyezzük el, melyre kattintva a sakktáblán az elhelyezés szerint a vezérek (V betűk) megjelennek. A keresés végén a program írja ki az elhelyezési lehetőségek számát.

A program néhány futási képe. Méret = 5:

Méret = 8:

Méret = 12:

A program listája:

unit UBTrVezer;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, 

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

Const Max=20;

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

var
fmBTrVezer: TfmBTrVezer;
ACol, ARow: Integer;
  T: Array[1..Max] Of Word;
Meret: Word;
  N: 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
If gdFixed In State Then Color:=clWhite;

If gdSelected In State Then Color:= clSilver;

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;
sgTabla.Canvas.TextRect(Rect,Rect.Left+10,Rect.Top+4,sgTabla.Cells[Col,Row]);
If gdFocused In State Then sgTabla.Canvas.DrawFocusRect(Rect);
end;

procedure TfmBTrVezer.FormCreate(Sender: TObject);
begin
Meret:= 8;
btAlapClick(Sender);
end;

procedure TfmBTrVezer.btAlapClick(Sender: TObject);
Var I, J: Word;
begin
With sgBTrVezer Do
Begin
ColCount:= Meret+1;
ColWidths[0]:= 52;
For I:= 1 To Meret Do Cells[I,0]:= Chr(96+I);
For I:= 1 To 92 Do Cells[0,I]:= IntToStr(I)+'.';
End;

With sgTabla Do
Begin
ColCount:= Meret+2;
RowCount:= Meret+2;
For I:= 1 To ColCount-2 Do ColWidths[I]:= 40;
For I:= 1 To RowCount-1 Do RowHeights[I]:= 32;
ColWidths[ColCount-1]:= 0;
RowHeights[RowCount-1]:= 0;
For I:= 1 To Meret Do Cells[0,I]:= IntToStr(Meret+1-I);
For I:= 1 To Meret Do Cells[I,0]:= Chr(96+I);
    Col:= ColCount-1; Row:= RowCount-1;
End;
With sgBTrVezer Do
For I:= 1 To ColCount-1 Do For J:= 1 To RowCount-1 Do Cells[I,J]:= '';
With sgTabla Do
For I:= 1 To ColCount-1 Do For J:= 1 To RowCount-1 Do Cells[I,J]:= '';
lbKesz.Caption:= '';
  N:= 0; lbN.Caption:= IntToStr(N);
end;

Function TfmBTrVezer.Rossz(B,C: Word): Boolean;
Begin
Rossz:= (T[B]=T[C]) Or (Abs(T[B]-T[C])=Abs(B-C));
End;

Function TfmBTrVezer.Jo(A: Word): Boolean;
Var J: Word;
Begin
  J:= 1; While Not Rossz(A,J) And (J<A) Do Inc(J); Jo:= A=J;
End;

Procedure TfmBTrVezer.Keres;
Var I, J: Word;
Vege: Boolean;
Begin
Vege:= False; For I:= 1 To Meret Do T[I]:= 0; I:= 1;
Repeat
While I In [1..Meret] Do
Begin
      Inc(T[I]);
If T[I]>Meret Then Begin T[I]:= 0; Dec(I); End Else If Jo(I) Then Inc(I);
End;
If I>Meret Then
Begin
Tablara; Inc(N);
With sgBTrVezer Do
Begin
If RowCount<N+1 Then
Begin
Cells[0,RowCount-1]:= IntToStr(RowCount-1)+'.';
RowCount:= N+1;
End;
For J:= 1 To Meret Do Begin Cells[J,N]:= IntToStr(T[J]) End;
End;
End;
If I>1 Then Begin Dec(I); Inc(T[I]) End Else Vege:= True;
Until Vege;
With sgBTrVezer Do If RowCount>94 Then
Begin
RowCount:= RowCount+1;
Cells[0,RowCount-2]:= IntToStr(RowCount-2)+'.';
End;
End;

Procedure TfmBTrVezer.Tablara;
Var I, J: Word;
Begin
With sgTabla Do
Begin
For I:= 1 To Meret Do For J:= 1 To Meret Do Cells[I,J]:= '';
For I:= 1 To Meret Do If T[I]<>0 Then Cells[I,Meret+1-T[I]]:= 'V';
End;
End;

procedure TfmBTrVezer.btStartClick(Sender: TObject);
begin
sgBTrVezer.RowCount:= 94; N:= 0;
  Keres; lbKesz.Caption:= 'Kész:'; lbN.Caption:= IntToStr(N);
end;

procedure TfmBTrVezer.sgBTrVezerClick(Sender: TObject);
Var I, J: Word;
begin
With sgTabla Do
For I:= 1 To ColCount-1 Do For J:= 1 To RowCount-1 Do Cells[I,J]:= '';
With sgBTrVezer Do If Cells[Col,Row]<>'' Then
For I:= 1 To ColCount-1 Do
sgTabla.Cells[I,Meret+1-StrToInt(Cells[I,Row])]:= 'V';
end;

procedure TfmBTrVezer.edMeretChange(Sender: TObject);
Var Kod: Integer;
begin
Val(edMeret.Text,Meret,Kod);
btAlapClick(Sender);
end;

end.