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

  GraphicsControlsFormsDialogsStdCtrlsGrids;

Const Max=8;

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

var
  fmBTrVezerTfmBTrVezer;
  AColARow: Integer;
  N: Word;
  T: Array[1..Max] Of Byte;
  I: 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
    {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 StateOr (gdFixed In State)) Then
    Case Odd(Col) XOr Odd(RowOf
      FalseColor:= clWindow;
      TrueColor:= 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(SenderTObject);
Var I: Word;
    ChChar;
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(SenderTObject);
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(SenderTObject);
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.