【delphi开源代码栏目提醒】:以下是网学会员为您推荐的delphi开源代码-U_8QueensPlus2.pas,希望本篇文章对您学习有所帮助。
unit U_8QueensPlus2;
{Problem is to place 8 tokens on a chess board so that no 2 are in
line and none are on the main diagonals.
I defined Board as an 8X8 array of integers to represent
the chessboard. Board is initialize with 0's to indicate and
available position, -1's to mark forbidden positions (the main
diagonals) and the token number to indicate a token.
PlaceCounter(n) searches recursively for a position for queen n by
searching all possible locations. Functions "RowisClear",
"ColIsClear" and "DiagsAreClear" check that a token can be legally
placed and tries to place the queen N+1 if a place is found (if n <8).
If queen cannot be placed, then return false. When all have been tried,
the final result is returned up the line.
}
{Version 2 - Find multiple solutions}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Grids, Buttons;
type
TBoard=array[1..8,1..8] of integer;
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
StringGrid1: TStringGrid;
BitBtn1: TBitBtn;
Memo1: TMemo;
procedure SolveBtn(Sender: TObject);
procedure FormActivate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
board:TBoard;
counter:integer;
Startcol,StartRow:integer;
Function PlaceCounter(n:integer):boolean;
Procedure Initboard;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
Function TForm1.PlaceCounter(n:integer):boolean;
{The search routine - looks for a place for queen # n}
var
i,j:integer;
placed,r :boolean;
prevboard:TBoard;
Function RowIsClear(x:integer):boolean;
var
i:integer;
Begin
result:=true;
i:=1;
While (result=true) and (i<=8) do
Begin
if (board[i,x]>0) then result:=false
else inc(i);
End;
end;
Function ColIsClear(x:integer):boolean;
var
i:integer;
Begin
result:=true;
i:=1;
While (result=true) and (i<=8) do
Begin
if (board[x,i]>0) then result:=false
else inc(i);
End;
end;
Function DiagsAreClear(x,y:integer):boolean;
var
i,j:integer;
Begin
result:=true;
{go up and left}
i:=x-1;
j:=y-1;
while (result=true) and (i>=1) and (j>=1)
do if board[i,j]>0 then result:=false
else
Begin
dec(i);
dec(j);
end;
{go up and right}
i:=x+1;
j:=y-1;
while (result=true) and (i<=8) and (j>=1)
do if board[i,j]>0 then result:=false
else
Begin
inc(i);
dec(j);
end;
{go down and left}
i:=x-1;
j:=y+1;
while (result=true) and (i>=1) and (j<=8)
do if board[i,j]>0 then result:=false
else
Begin
dec(i);
inc(j);
end;
{go down and right}
i:=x+1;
j:=y+1;
while (result=true) and (i<=8) and (j<=8)
do if board[i,j]>0 then result:=false
else
Begin
inc(i);
inc(j);
end;
end;
Begin
inc(counter);
prevboard:=board;
placed:=false;
if n>1 then
Begin
i:=2;
j:=1;
end
else
Begin
i:=startcol;
j:=startrow;
End;
while (i<=8) and (j<=8) and not placed do
Begin
r:=RowIsClear(j);
if (board[i,j]=0)
and r
and ColIsClear(i)
and DiagsAreClear(i,j)
then
Begin
board[i,j]:=n;
placed:=true;
end
else
Begin
if not r then i:=9 else inc(i);
if i>8 then
Begin
i:=1;
inc(j);
end;
end;
if placed
then
if (n<8) then placed:=placeCounter(n+1)
else
else board:=prevboard; {erase that move and continue search}
end;
result:=placed;
end;
Procedure TForm1.InitBoard;
{initialize the board}
var
i,j:integer;
Begin
for i:=1 to 8 do
for j:= 1 to 8 do
board[i,j]:=0;
{mark diagonals as unavailable}
for i:=1 to 8 do
Begin
board[i,i]:=-1;
board[i,9-i]:=-1;
end;
End;
procedure TForm1.SolveBtn(Sender: TObject);
var
i,j:integer;
begin
initboard;
counter:=0;
if placecounter(1) then {solution found}
Begin
label2.caption:='Solved!';
Bitbtn1.caption:='Search for another solution';
i:=1;
j:=1;
{Version 2 -
Set up to start at the next position after the first queen
placed when the user presses the solve button again}
{find the first used position}
while (i<=8) and (board[i,j]<>1) do
Begin
inc(j);
If j>8 then
Begin
inc(i);
j:=1;
End;
End;
{if we found it, then}
if (i<=8) and (board[i,j]=1) then
Begin
{set next start position}
startcol:=i+1;
startrow:=j;
If startcol>8 then
Begin
inc(startrow);
startcol:=1;
End;
end
else {shouldn't get here}
Begin
startcol:=2;
startrow:=1;
End;
{draw the board}
for i:=1 to 8 do
for j:= 1 to 8 do
with stringgrid1 do
if board[i,j]=-1
then cells[i-1,j-1]:='X'
else
if board[i,j]>0
then cells[i-1,j-1]:=inttostr(board[i,j])
else cells[i-1,j-1]:=' ';
End
else
Begin
label2.caption:='Sorry - no more, starting over';
startcol:=2;
Startrow:=1;
Bitbtn1.caption:='Solve';
End;
label1.caption:='Postions tried='+inttostr(counter);
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
Initboard;
Startcol:=2;
StartRow:=1;
end;
end.
上一篇:
uylegend.pas
下一篇:
应用数学学报编辑部联系方式