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, MessagesSysUtilsVariantsClasses

  GraphicsControlsFormsDialogsStdCtrlsGrids;

Const Max=20;

type
  TfmBTrVezer = class(TForm)
    lbBTrVezerTLabel;
    btKilepesTButton;
    sgBTrVezerTStringGrid;
    sgTablaTStringGrid;
    btStartTButton;
    btAlapTButton;
    lbKeszTLabel;
    lbMeretTLabel;
    edMeretTEdit;
    lbNTLabel;
    Function Rossz(B,C: Word): Boolean;
    Function Jo(A: Word): Boolean;
    Procedure Keres;
    Procedure Tablara;
    procedure btKilepesClick(SenderTObject);
    procedure FormCreate(SenderTObject);
    procedure sgTablaDrawCell(SenderTObject; Col, Row: Integer;
      RectTRectStateTGridDrawState);
    procedure btAlapClick(SenderTObject);
    procedure btStartClick(SenderTObject);
    procedure sgBTrVezerClick(SenderTObject);
    procedure edMeretChange(SenderTObject);
  private
    Private declarations }
  public
    Public declarations }
  end;

var
  fmBTrVezerTfmBTrVezer;
  AColARow: Integer;
  T: Array[1..Max] Of Word;
  Meret: Word;
  N: Word;

implementation

{$R *.dfm}

procedure TfmBTrVezer.btKilepesClick(SenderTObject);
begin
  Close;
end;

procedure TfmBTrVezer.sgTablaDrawCell(SenderTObject; Col, Row: Integer;
  RectTRectStateTGridDrawState);
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 StateOr (gdFixed In State)) Then
    Case Odd(Col) XOr Odd(RowOf
      FalseColor:= clWindow;
      TrueColor:= 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(SenderTObject);
begin
  Meret:= 8;
  btAlapClick(Sender);
end;

procedure TfmBTrVezer.btAlapClick(SenderTObject);
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;
    VegeBoolean;
Begin
  Vege:= FalseFor 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(SenderTObject);
begin
  sgBTrVezer.RowCount:= 94; N:= 0;
  Keres; lbKesz.Caption:= 'Kész:'; lbN.Caption:= IntToStr(N);
end;

procedure TfmBTrVezer.sgBTrVezerClick(SenderTObject);
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(SenderTObject);
Var Kod: Integer;
begin
  Val(edMeret.Text,Meret,Kod);
  btAlapClick(Sender);
end;

end.