关于黑白棋，如何设置两种棋盘的自动调用 ( 积分: 100 )

  • 主题发起人 主题发起人 wgntk
  • 开始时间 开始时间
W

wgntk

Unregistered / Unconfirmed
GUEST, unregistred user!
各位大哥大姐，我现在被一个问题：
我做了一个黑白棋游戏，棋盘大小是8*8的。如何在游戏菜单里设置可以选择6*6，和8*8两种，选哪个棋盘出来哪个形式。
代码如下：
1。主界面
unit untBWC;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, untEngine, ExtCtrls, StdCtrls, Menus;

Const
BWC_VS=0;
BWC_PLAY=1;
PutChessTime=500;

type
TfrmBWC = class(TForm)
pbC: TPaintBox;
lbC: TLabel;
MainMenu1: TMainMenu;
mnuGame: TMenuItem;
mnuGameNew: TMenuItem;
mnuGameExit: TMenuItem;
mnuGameNewVS: TMenuItem;
mnuGameNewPlay1: TMenuItem;
mnuGameShowvalue: TMenuItem;
mnuGameShowcd: TMenuItem;
mnuGameCC: TMenuItem;
mnuHelp: TMenuItem;
mnuHelpAbout: TMenuItem;
N1: TMenuItem;
N2: TMenuItem;
N661: TMenuItem;
N881: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure pbCPaint(Sender: TObject);
procedure mnuGameNewVSClick(Sender: TObject);
procedure mnuGameNewPlay1Click(Sender: TObject);
procedure pbCMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure mnuGameExitClick(Sender: TObject);

procedure mnuGameShowvalueClick(Sender: TObject);
procedure mnuGameShowcdClick(Sender: TObject);
procedure mnuGameCCClick(Sender: TObject);
procedure mnuHelpAboutClick(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure N661Click(Sender: TObject);
procedure N881Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
Procedure NewGame(BWCStyle:Integer);
Procedure ChangeMessage;
Procedure PutChess(X,Y:Integer);
Procedure RefreshBrd;
end;

TChessCount=Record
White,Black:Integer;
End;

var
frmBWC: TfrmBWC;
Style:Integer;
Player:Integer;
Level:Integer;
ChessCount:Array[0..64]Of TChessCount;
ChessCounts:Integer;

implementation

uses untChessCount, untAbout;

{$R *.dfm}
{清理棋盘}
Procedure TfrmBWC.RefreshBrd;
var X,Y:Integer;
Begin
bwcDraw(pbC.Canvas,Player,mnuGameShowcd.Checked);
If mnuGameShowvalue.Checked=False Then Exit;
pbC.Canvas.Brush.Style:=bsClear;
pbC.Canvas.Font.Color:=16777215;
For X:=1 To 8 Do
For Y:=1 To 8 Do
If Level=0 Then
pbC.Canvas.TextOut((X-1)*50,(Y-1)*50,IntToStr(bwcGetPositionValue(Board,X,Y,Player,2)))
Else
pbC.Canvas.TextOut((X-1)*50,(Y-1)*50,IntToStr(bwcGetPositionValue(Board,X,Y,Player,Level)));
End;
{实现在棋盘上下棋}
Procedure TfrmBWC.PutChess(X,Y:Integer);
Begin
If bwcGetEatCount(Board,(X div 50)+1,(Y div 50)+1,Player)=0 Then
Begin
ShowMessage('此位置不能下棋。');
Exit;
End;
bwcPutChess(Board,(X div 50)+1,(Y div 50)+1,Player);
Player:=(Player+1) mod 2;
RefreshBrd;
ChessCount[ChessCounts].White:=bwcGetChessCount(Board,0);
ChessCount[ChessCounts].Black:=bwcGetChessCount(Board,1);
ChessCounts:=ChessCounts+1;
If bwcCanPutChess(Board,Player)=False Then
Begin
Player:=(Player+1) mod 2;
If bwcCanPutChess(Board,Player)=False Then
If bwcGetChessCount(Board,0)>bwcGetChessCount(Board,1) Then
Begin
ChangeMessage;
ShowMessage('白方获胜。');
frmChessCount.ShowModal;
Player:=0;
End
Else If bwcGetChessCount(Board,0)<bwcGetChessCount(Board,1) Then
Begin
ChangeMessage;
ShowMessage('黑方获胜。');
frmChessCount.ShowModal;
Player:=0;
End
Else
Begin
ChangeMessage;
ShowMessage('和棋。');
frmChessCount.ShowModal;
Player:=0;
End
Else
If Player=0 Then
ShowMessage('轮到白方下棋。')
Else
ShowMessage('轮到黑方下棋。');
End;

ChangeMessage;
End;
{开始新游戏}
Procedure TfrmBWC.NewGame(BWCStyle:Integer);
Begin
Style:=BWCStyle;
bwcClearBoard;
Player:=0;
RefreshBrd;
ChangeMessage;
Randomize;
If Style=BWC_VS Then
Caption:='夹子棋[双人对战]'
Else
Caption:='夹子棋[人机对弈]';
ChessCounts:=5;
ChessCount[0].White:=0;
ChessCount[0].Black:=0;
ChessCount[1].White:=1;
ChessCount[1].Black:=0;
ChessCount[2].White:=1;
ChessCount[2].Black:=1;
ChessCount[3].White:=2;
ChessCount[3].Black:=1;
ChessCount[4].White:=2;
ChessCount[4].Black:=2;
End;
{改变棋盘上提示下子的信息}
Procedure TfrmBWC.ChangeMessage;
var R:String;
Begin
R:='白棋'+IntToStr(bwcGetChessCount(Board,0))+' ';
R:=R+'黑棋'+IntToStr(bwcGetChessCount(Board,1))+' ';
If Player=0 Then
R:=R+'白棋执子'
Else
R:=R+'黑棋执子';
lbC.Caption:=R;
End;
{产生棋盘的大框架}
procedure TfrmBWC.FormCreate(Sender: TObject);
begin
frmBWC.Left:=(Screen.Width-frmBWC.Width) div 2;
frmBWC.Top:=(Screen.Height-frmBWC.Height) div 2;
bwcInit;
bwcClearBoard;
NewGame(BWC_VS);
end;
{结束后释放棋盘的棋子}
procedure TfrmBWC.FormDestroy(Sender: TObject);
begin
bwcFree;
end;

procedure TfrmBWC.pbCPaint(Sender: TObject);
begin
RefreshBrd;
end;
{点击开始新的对战信息}
procedure TfrmBWC.mnuGameNewVSClick(Sender: TObject);
begin
Level:=0;
NewGame(BWC_VS);
(Sender As TMenuItem).Checked:=True;
end;
{开始人机对战}
procedure TfrmBWC.mnuGameNewPlay1Click(Sender: TObject);
begin
Level:=1;
NewGame(BwC_PLAY);
(Sender As TMenuItem).Checked:=True;
end;
{棋盘上实现下子}
procedure TfrmBWC.pbCMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var R:Integer;
begin
If Style=BWC_VS Then
PutChess(X,Y)
Else
Begin
If Player=0 Then
PutChess(X,Y);
If Player=1 Then
Begin
Repeat
Sleep(PutChessTime);
R:=bwcGetBestPosition(Level);
PutChess((R mod 10)*50-1,(R div 10)*50-1);
Until Player=0;
End;
End;
end;

procedure TfrmBWC.mnuGameExitClick(Sender: TObject);
begin
Close;
end;


procedure TfrmBWC.mnuGameShowvalueClick(Sender: TObject);
begin
mnuGameShowvalue.Checked:=Not mnuGameShowvalue.Checked;
RefreshBrd;
end;

procedure TfrmBWC.mnuGameShowcdClick(Sender: TObject);
begin
mnuGameShowcd.Checked:=Not mnuGameShowcd.Checked;
RefreshBrd;
end;

procedure TfrmBWC.mnuGameCCClick(Sender: TObject);
begin
frmChessCount.ShowModal;
end;

procedure TfrmBWC.mnuHelpAboutClick(Sender: TObject);
begin
frmAbout.ShowModal;
end;

procedure TfrmBWC.N1Click(Sender: TObject);
var
str:string;
begin

str:='◆ 作者：岳鹏'#13+

'◆ 指导老师：刘天时'#13+

'◆完成时间：2005.5.30 ' ;

MessageDlg(str,mtInformation,[mbOK],0);
end;

procedure TfrmBWC.N661Click(Sender: TObject);
begin

end;

procedure TfrmBWC.N881Click(Sender: TObject);
begin

end;

end.
2。下棋的程序
unit untEngine;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;

Const Paths:Array[0..3]Of String=(
'White.bmp','Black.bmp','Back.bmp','Position.bmp');
BWCDirection:Array[0..7]Of Array[0..1]Of Integer=(
(0,-1),(1,-1),(1,0),(1,1),(0,1),(-1,1),(-1,0),(-1,-1));

Type
TBoard=Array[0..9]Of Array[0..9]Of Integer;

var Board:TBoard;
Pic:Array[0..3]Of TBitmap;
BmpBrd:TBitmap;

Procedure bwcInit;
Procedure bwcFree;
Procedure bwcClearBoard;
Procedure bwcDraw(Canvas:TCanvas;Color:Integer;ShowCanDown:Boolean);
Function bwcGetEatCount(Brd:TBoard;X,Y,Color:Integer):Integer;
Procedure bwcPutChess(var Brd:TBoard;X,Y,Color:Integer);
Function bwcCanPutChess(Brd:TBoard;Color:Integer):Boolean;
Function bwcGetChessCount(Brd:TBoard;Color:Integer):Integer;
///////////////////////////////////////////////////////////////////////////
Procedure bwcCopyBoard(var Dst:TBoard;Src:TBoard);
Function bwcGetPositionValue1(Brd:TBoard;X,Y,Color:Integer):Integer;
Function bwcGetPositionValue2(Brd:TBoard;bX,bY,Color:Integer):Integer;
Function bwcGetPositionValue(Brd:TBoard;X,Y,Color:Integer;Level:Integer):Integer;
Function bwcGetBestPosition(Level:Integer):Integer;

implementation
{调用棋子,落子,可下位置的图片}
Procedure bwcInit;
var I:Integer;
Begin
For I:=0 TO 3 Do
Begin
Pic:=TBitmap.Create;
Pic.LoadFromFile(ExtractFilePath(ParamStr(0))+Paths);
End;
BmpBrd:=TBitmap.Create;
BmpBrd.Width:=400;
BmpBrd.Height:=400;
End;
{释放图片}
Procedure bwcFree;
var I:Integer;
Begin
For I:=0 To 3 Do
Pic.Free;
BmpBrd.Free;
End;
{初始化棋盘上的棋子}
Procedure bwcClearBoard;
var X,Y:Integer;
Begin
For X:=0 To 9 Do
For Y:=0 To 9 Do
Board[X,Y]:=2;
Board[4,4]:=1;
Board[4,5]:=0;
Board[5,4]:=0;
Board[5,5]:=1;
End;
{在指定的位置显示黑棋和白棋的图片}
Procedure bwcDraw(Canvas:TCanvas;Color:Integer;ShowCanDown:Boolean);
var X,Y:Integer;
Begin
For X:=1 To 8 Do
For Y:=1 To 8 Do
Begin
If Board[X,Y]=2 Then
If ShowCanDown=True Then
If bwcGetEatCount(Board,X,Y,Color)>0 Then
BmpBrd.Canvas.Draw((X-1)*50,(Y-1)*50,Pic[3])
Else
BmpBrd.Canvas.Draw((X-1)*50,(Y-1)*50,Pic[2])
Else
BmpBrd.Canvas.Draw((X-1)*50,(Y-1)*50,Pic[2])
Else
BmpBrd.Canvas.Draw((X-1)*50,(Y-1)*50,Pic[Board[X,Y]]);
End;
Canvas.Draw(0,0,BmpBrd);
End;
{实现吃子的代码}
Function bwcGetEatCount(Brd:TBoard;X,Y,Color:Integer):Integer;
var Direction,cX,cY,EatCount,Distance:Integer;
Begin
If Brd[X,Y]<>2 Then
Begin
bwcGetEatCount:=0;
Exit;
End;
EatCount:=0;
For Direction:=0 To 7 Do
Begin
cX:=X;
cY:=Y;
Distance:=0;
Repeat
cX:=cX+BWCDirection[Direction,0];
cY:=cY+BWCDirection[Direction,1];
Distance:=Distance+1;
If Brd[cX,cY]=2 Then
Break;
If Brd[cX,cY]=Color Then
Begin
EatCount:=EatCount+Distance-1;
Break;
End;
Until((cX=0)Or(cX=9)Or(cY=0)Or(cY=9));
End;
bwcGetEatCount:=EatCount;
End;
{实现下子的代码}
Procedure bwcPutChess(var Brd:TBoard;X,Y,Color:Integer);
var Direction,cX,cY,pX,pY:Integer;
Begin
For Direction:=0 To 7 Do
Begin
cX:=X;
cY:=Y;
Repeat
cX:=cX+BWCDirection[Direction,0];
cY:=cY+BWCDirection[Direction,1];
If Brd[cX,cY]=2 Then
Break;
If Brd[cX,cY]=Color Then
Begin
pX:=X;
pY:=Y;
Repeat
pX:=pX+BWCDirection[Direction,0];
pY:=pY+BWCDirection[Direction,1];
Brd[pX,pY]:=Color;
Until (pX=cX)And(pY=cY);
Break;
End;
Until((cX=0)Or(cX=9)Or(cY=0)Or(cY=9));
End;
Brd[X,Y]:=Color;
End;
{一方下子后另一方是否可以下子的代码}
Function bwcCanPutChess(Brd:TBoard;Color:Integer):Boolean;
var EatCount,X,Y:Integer;
Begin
EatCount:=0;
For X:=1 To 8 Do
For Y:=1 To 8 Do
EatCount:=EatCount+bwcGetEatCount(Brd,X,Y,Color);
If EatCount=0 Then
bwcCanPutChess:=False
Else
bwcCanPutChess:=True;
End;
{计算棋子数}
Function bwcGetChessCount(Brd:TBoard;Color:Integer):Integer;
var X,Y,R:Integer;
Begin
R:=0;
For X:=1 To 8 Do
For Y:=1 To 8 Do
If Brd[X,Y]=Color Then
R:=R+1;
bwcGetChessCount:=R;
End;

////////////////////////////////////////////////////////////////////

Procedure bwcCopyBoard(var Dst:TBoard;Src:TBoard);
var X,Y:Integer;
Begin
For X:=0 To 9 Do
For Y:=0 To 9 Do
Dst[X,Y]:=Src[X,Y];
End;
{显示位置的价值}
Function bwcGetPositionValue1(Brd:TBoard;X,Y,Color:Integer):Integer;
var R:Integer;
Begin
R:=bwcGetEatCount(Brd,X,Y,Color);
bwcGetPositionValue1:=R;
End;

Function bwcGetPositionValue2(Brd:TBoard;bX,bY,Color:Integer):Integer;
var R,R2,X,Y,AddValue,Color2:Integer;
TempBrd,TempBrd2:TBoard;
AngleValue:Array[0..1]Of Array[0..1]Of Integer;
Begin
bwcCopyBoard(TempBrd,Board);
R:=0;
AddValue:=0;
If bwcGetEatCount(TempBrd,bX,bY,Color)>0 Then
Begin

AddValue:=200;

For X:=0 To 1 Do
For Y:=0 To 1 Do
AngleValue[X,Y]:=bwcGetEatCount(Board,X*7+1,Y*7+1,Color);
If((AngleValue[0,0]>0)Or(AngleValue[0,1]>0)Or(AngleValue[1,0]>0)Or(AngleValue[1,1]>0)) Then
AddValue:=400;

bwcPutChess(TempBrd,bX,bY,Color);
For X:=0 To 1 Do
For Y:=0 To 1 Do
AngleValue[X,Y]:=bwcGetEatCount(TempBrd,X*7+1,Y*7+1,Color);
If((AngleValue[0,0]>0)Or(AngleValue[0,1]>0)Or(AngleValue[1,0]>0)Or(AngleValue[1,1]>0)) Then
AddValue:=300;

Color2:=(Color+1)mod 2;
For X:=0 To 1 Do
For Y:=0 To 1 Do
AngleValue[X,Y]:=bwcGetEatCount(TempBrd,X*7+1,Y*7+1,Color2);
If((AngleValue[0,0]>0)Or(AngleValue[1,0]>0)Or(AngleValue[1,0]>0)Or(AngleValue[1,1]>0)) Then
AddValue:=100;

R:=10000;

For X:=1 To 8 Do
For Y:=1 To 8 Do
Begin
bwcCopyBoard(TempBrd2,TempBrd);
If bwcGetEatCount(TempBrd2,X,Y,Color2)>0 Then
bwcPutChess(TempBrd2,X,Y,Color2);
R2:=bwcGetChessCount(TempBrd2,Color)-bwcGetChessCount(TempBrd2,Color2);
If R2<R Then
R:=R2;
End;
If R=10000 Then
Begin
bwcGetPositionValue2:=0;
Exit;
End;
End;
bwcGetPositionValue2:=R+AddValue;
End;

Function bwcGetPositionValue(Brd:TBoard;X,Y,Color:Integer;Level:Integer):Integer;
var R:Integer;
Begin
Case Level Of
1:
Begin
R:=bwcGetPositionValue1(Brd,X,Y,Color);
End;
2:
Begin
R:=bwcGetPositionValue2(Brd,X,Y,Color);
End;
End;
bwcGetPositionValue:=R;
End;

Function bwcGetBestPosition(Level:Integer):Integer;
var Values:Array[1..8]Of Array[1..8]Of Integer;
X,Y,I:Integer;
BestValue,BestCount:Integer;
BestPosition:Array Of TPoint;
Begin
For X:=1 To 8 Do
For Y:=1 To 8 Do
Values[X,Y]:=bwcGetPositionValue(Board,X,Y,1,Level);
BestValue:=0;
For X:=1 To 8 Do
For Y:=1 To 8 Do
If Values[X,Y]>BestValue Then
BestValue:=Values[X,Y];
BestCount:=0;
For X:=1 To 8 Do
For Y:=1 To 8 Do
If Values[X,Y]=BestValue Then
BestCount:=BestCount+1;
SetLength(BestPosition,BestCount);
BestCount:=0;
For X:=1 To 8 Do
For Y:=1 To 8 Do
If Values[X,Y]=BestValue Then
Begin
BestPosition[BestCount].X:=X;
BestPosition[BestCount].Y:=Y;
BestCount:=BestCount+1;
End;
I:=Random(BestCount);
If I=BestCount THen
I:=I-1;
bwcGetBestPosition:=BestPosition.X+BestPosition.Y*10;
End;

end.
 
各位大哥大姐，我现在被一个问题：
我做了一个黑白棋游戏，棋盘大小是8*8的。如何在游戏菜单里设置可以选择6*6，和8*8两种，选哪个棋盘出来哪个形式。
代码如下：
1。主界面
unit untBWC;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, untEngine, ExtCtrls, StdCtrls, Menus;

Const
BWC_VS=0;
BWC_PLAY=1;
PutChessTime=500;

type
TfrmBWC = class(TForm)
pbC: TPaintBox;
lbC: TLabel;
MainMenu1: TMainMenu;
mnuGame: TMenuItem;
mnuGameNew: TMenuItem;
mnuGameExit: TMenuItem;
mnuGameNewVS: TMenuItem;
mnuGameNewPlay1: TMenuItem;
mnuGameShowvalue: TMenuItem;
mnuGameShowcd: TMenuItem;
mnuGameCC: TMenuItem;
mnuHelp: TMenuItem;
mnuHelpAbout: TMenuItem;
N1: TMenuItem;
N2: TMenuItem;
N661: TMenuItem;
N881: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure pbCPaint(Sender: TObject);
procedure mnuGameNewVSClick(Sender: TObject);
procedure mnuGameNewPlay1Click(Sender: TObject);
procedure pbCMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure mnuGameExitClick(Sender: TObject);

procedure mnuGameShowvalueClick(Sender: TObject);
procedure mnuGameShowcdClick(Sender: TObject);
procedure mnuGameCCClick(Sender: TObject);
procedure mnuHelpAboutClick(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure N661Click(Sender: TObject);
procedure N881Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
Procedure NewGame(BWCStyle:Integer);
Procedure ChangeMessage;
Procedure PutChess(X,Y:Integer);
Procedure RefreshBrd;
end;

TChessCount=Record
White,Black:Integer;
End;

var
frmBWC: TfrmBWC;
Style:Integer;
Player:Integer;
Level:Integer;
ChessCount:Array[0..64]Of TChessCount;
ChessCounts:Integer;

implementation

uses untChessCount, untAbout;

{$R *.dfm}
{清理棋盘}
Procedure TfrmBWC.RefreshBrd;
var X,Y:Integer;
Begin
bwcDraw(pbC.Canvas,Player,mnuGameShowcd.Checked);
If mnuGameShowvalue.Checked=False Then Exit;
pbC.Canvas.Brush.Style:=bsClear;
pbC.Canvas.Font.Color:=16777215;
For X:=1 To 8 Do
For Y:=1 To 8 Do
If Level=0 Then
pbC.Canvas.TextOut((X-1)*50,(Y-1)*50,IntToStr(bwcGetPositionValue(Board,X,Y,Player,2)))
Else
pbC.Canvas.TextOut((X-1)*50,(Y-1)*50,IntToStr(bwcGetPositionValue(Board,X,Y,Player,Level)));
End;
{实现在棋盘上下棋}
Procedure TfrmBWC.PutChess(X,Y:Integer);
Begin
If bwcGetEatCount(Board,(X div 50)+1,(Y div 50)+1,Player)=0 Then
Begin
ShowMessage('此位置不能下棋。');
Exit;
End;
bwcPutChess(Board,(X div 50)+1,(Y div 50)+1,Player);
Player:=(Player+1) mod 2;
RefreshBrd;
ChessCount[ChessCounts].White:=bwcGetChessCount(Board,0);
ChessCount[ChessCounts].Black:=bwcGetChessCount(Board,1);
ChessCounts:=ChessCounts+1;
If bwcCanPutChess(Board,Player)=False Then
Begin
Player:=(Player+1) mod 2;
If bwcCanPutChess(Board,Player)=False Then
If bwcGetChessCount(Board,0)>bwcGetChessCount(Board,1) Then
Begin
ChangeMessage;
ShowMessage('白方获胜。');
frmChessCount.ShowModal;
Player:=0;
End
Else If bwcGetChessCount(Board,0)<bwcGetChessCount(Board,1) Then
Begin
ChangeMessage;
ShowMessage('黑方获胜。');
frmChessCount.ShowModal;
Player:=0;
End
Else
Begin
ChangeMessage;
ShowMessage('和棋。');
frmChessCount.ShowModal;
Player:=0;
End
Else
If Player=0 Then
ShowMessage('轮到白方下棋。')
Else
ShowMessage('轮到黑方下棋。');
End;

ChangeMessage;
End;
{开始新游戏}
Procedure TfrmBWC.NewGame(BWCStyle:Integer);
Begin
Style:=BWCStyle;
bwcClearBoard;
Player:=0;
RefreshBrd;
ChangeMessage;
Randomize;
If Style=BWC_VS Then
Caption:='夹子棋[双人对战]'
Else
Caption:='夹子棋[人机对弈]';
ChessCounts:=5;
ChessCount[0].White:=0;
ChessCount[0].Black:=0;
ChessCount[1].White:=1;
ChessCount[1].Black:=0;
ChessCount[2].White:=1;
ChessCount[2].Black:=1;
ChessCount[3].White:=2;
ChessCount[3].Black:=1;
ChessCount[4].White:=2;
ChessCount[4].Black:=2;
End;
{改变棋盘上提示下子的信息}
Procedure TfrmBWC.ChangeMessage;
var R:String;
Begin
R:='白棋'+IntToStr(bwcGetChessCount(Board,0))+' ';
R:=R+'黑棋'+IntToStr(bwcGetChessCount(Board,1))+' ';
If Player=0 Then
R:=R+'白棋执子'
Else
R:=R+'黑棋执子';
lbC.Caption:=R;
End;
{产生棋盘的大框架}
procedure TfrmBWC.FormCreate(Sender: TObject);
begin
frmBWC.Left:=(Screen.Width-frmBWC.Width) div 2;
frmBWC.Top:=(Screen.Height-frmBWC.Height) div 2;
bwcInit;
bwcClearBoard;
NewGame(BWC_VS);
end;
{结束后释放棋盘的棋子}
procedure TfrmBWC.FormDestroy(Sender: TObject);
begin
bwcFree;
end;

procedure TfrmBWC.pbCPaint(Sender: TObject);
begin
RefreshBrd;
end;
{点击开始新的对战信息}
procedure TfrmBWC.mnuGameNewVSClick(Sender: TObject);
begin
Level:=0;
NewGame(BWC_VS);
(Sender As TMenuItem).Checked:=True;
end;
{开始人机对战}
procedure TfrmBWC.mnuGameNewPlay1Click(Sender: TObject);
begin
Level:=1;
NewGame(BwC_PLAY);
(Sender As TMenuItem).Checked:=True;
end;
{棋盘上实现下子}
procedure TfrmBWC.pbCMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var R:Integer;
begin
If Style=BWC_VS Then
PutChess(X,Y)
Else
Begin
If Player=0 Then
PutChess(X,Y);
If Player=1 Then
Begin
Repeat
Sleep(PutChessTime);
R:=bwcGetBestPosition(Level);
PutChess((R mod 10)*50-1,(R div 10)*50-1);
Until Player=0;
End;
End;
end;

procedure TfrmBWC.mnuGameExitClick(Sender: TObject);
begin
Close;
end;


procedure TfrmBWC.mnuGameShowvalueClick(Sender: TObject);
begin
mnuGameShowvalue.Checked:=Not mnuGameShowvalue.Checked;
RefreshBrd;
end;

procedure TfrmBWC.mnuGameShowcdClick(Sender: TObject);
begin
mnuGameShowcd.Checked:=Not mnuGameShowcd.Checked;
RefreshBrd;
end;

procedure TfrmBWC.mnuGameCCClick(Sender: TObject);
begin
frmChessCount.ShowModal;
end;

procedure TfrmBWC.mnuHelpAboutClick(Sender: TObject);
begin
frmAbout.ShowModal;
end;

procedure TfrmBWC.N1Click(Sender: TObject);
var
str:string;
begin

str:='◆ 作者：岳鹏'#13+

'◆ 指导老师：刘天时'#13+

'◆完成时间：2005.5.30 ' ;

MessageDlg(str,mtInformation,[mbOK],0);
end;

procedure TfrmBWC.N661Click(Sender: TObject);
begin

end;

procedure TfrmBWC.N881Click(Sender: TObject);
begin

end;

end.
2。下棋的程序
unit untEngine;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;

Const Paths:Array[0..3]Of String=(
'White.bmp','Black.bmp','Back.bmp','Position.bmp');
BWCDirection:Array[0..7]Of Array[0..1]Of Integer=(
(0,-1),(1,-1),(1,0),(1,1),(0,1),(-1,1),(-1,0),(-1,-1));

Type
TBoard=Array[0..9]Of Array[0..9]Of Integer;

var Board:TBoard;
Pic:Array[0..3]Of TBitmap;
BmpBrd:TBitmap;

Procedure bwcInit;
Procedure bwcFree;
Procedure bwcClearBoard;
Procedure bwcDraw(Canvas:TCanvas;Color:Integer;ShowCanDown:Boolean);
Function bwcGetEatCount(Brd:TBoard;X,Y,Color:Integer):Integer;
Procedure bwcPutChess(var Brd:TBoard;X,Y,Color:Integer);
Function bwcCanPutChess(Brd:TBoard;Color:Integer):Boolean;
Function bwcGetChessCount(Brd:TBoard;Color:Integer):Integer;
///////////////////////////////////////////////////////////////////////////
Procedure bwcCopyBoard(var Dst:TBoard;Src:TBoard);
Function bwcGetPositionValue1(Brd:TBoard;X,Y,Color:Integer):Integer;
Function bwcGetPositionValue2(Brd:TBoard;bX,bY,Color:Integer):Integer;
Function bwcGetPositionValue(Brd:TBoard;X,Y,Color:Integer;Level:Integer):Integer;
Function bwcGetBestPosition(Level:Integer):Integer;

implementation
{调用棋子,落子,可下位置的图片}
Procedure bwcInit;
var I:Integer;
Begin
For I:=0 TO 3 Do
Begin
Pic:=TBitmap.Create;
Pic.LoadFromFile(ExtractFilePath(ParamStr(0))+Paths);
End;
BmpBrd:=TBitmap.Create;
BmpBrd.Width:=400;
BmpBrd.Height:=400;
End;
{释放图片}
Procedure bwcFree;
var I:Integer;
Begin
For I:=0 To 3 Do
Pic.Free;
BmpBrd.Free;
End;
{初始化棋盘上的棋子}
Procedure bwcClearBoard;
var X,Y:Integer;
Begin
For X:=0 To 9 Do
For Y:=0 To 9 Do
Board[X,Y]:=2;
Board[4,4]:=1;
Board[4,5]:=0;
Board[5,4]:=0;
Board[5,5]:=1;
End;
{在指定的位置显示黑棋和白棋的图片}
Procedure bwcDraw(Canvas:TCanvas;Color:Integer;ShowCanDown:Boolean);
var X,Y:Integer;
Begin
For X:=1 To 8 Do
For Y:=1 To 8 Do
Begin
If Board[X,Y]=2 Then
If ShowCanDown=True Then
If bwcGetEatCount(Board,X,Y,Color)>0 Then
BmpBrd.Canvas.Draw((X-1)*50,(Y-1)*50,Pic[3])
Else
BmpBrd.Canvas.Draw((X-1)*50,(Y-1)*50,Pic[2])
Else
BmpBrd.Canvas.Draw((X-1)*50,(Y-1)*50,Pic[2])
Else
BmpBrd.Canvas.Draw((X-1)*50,(Y-1)*50,Pic[Board[X,Y]]);
End;
Canvas.Draw(0,0,BmpBrd);
End;
{实现吃子的代码}
Function bwcGetEatCount(Brd:TBoard;X,Y,Color:Integer):Integer;
var Direction,cX,cY,EatCount,Distance:Integer;
Begin
If Brd[X,Y]<>2 Then
Begin
bwcGetEatCount:=0;
Exit;
End;
EatCount:=0;
For Direction:=0 To 7 Do
Begin
cX:=X;
cY:=Y;
Distance:=0;
Repeat
cX:=cX+BWCDirection[Direction,0];
cY:=cY+BWCDirection[Direction,1];
Distance:=Distance+1;
If Brd[cX,cY]=2 Then
Break;
If Brd[cX,cY]=Color Then
Begin
EatCount:=EatCount+Distance-1;
Break;
End;
Until((cX=0)Or(cX=9)Or(cY=0)Or(cY=9));
End;
bwcGetEatCount:=EatCount;
End;
{实现下子的代码}
Procedure bwcPutChess(var Brd:TBoard;X,Y,Color:Integer);
var Direction,cX,cY,pX,pY:Integer;
Begin
For Direction:=0 To 7 Do
Begin
cX:=X;
cY:=Y;
Repeat
cX:=cX+BWCDirection[Direction,0];
cY:=cY+BWCDirection[Direction,1];
If Brd[cX,cY]=2 Then
Break;
If Brd[cX,cY]=Color Then
Begin
pX:=X;
pY:=Y;
Repeat
pX:=pX+BWCDirection[Direction,0];
pY:=pY+BWCDirection[Direction,1];
Brd[pX,pY]:=Color;
Until (pX=cX)And(pY=cY);
Break;
End;
Until((cX=0)Or(cX=9)Or(cY=0)Or(cY=9));
End;
Brd[X,Y]:=Color;
End;
{一方下子后另一方是否可以下子的代码}
Function bwcCanPutChess(Brd:TBoard;Color:Integer):Boolean;
var EatCount,X,Y:Integer;
Begin
EatCount:=0;
For X:=1 To 8 Do
For Y:=1 To 8 Do
EatCount:=EatCount+bwcGetEatCount(Brd,X,Y,Color);
If EatCount=0 Then
bwcCanPutChess:=False
Else
bwcCanPutChess:=True;
End;
{计算棋子数}
Function bwcGetChessCount(Brd:TBoard;Color:Integer):Integer;
var X,Y,R:Integer;
Begin
R:=0;
For X:=1 To 8 Do
For Y:=1 To 8 Do
If Brd[X,Y]=Color Then
R:=R+1;
bwcGetChessCount:=R;
End;

////////////////////////////////////////////////////////////////////

Procedure bwcCopyBoard(var Dst:TBoard;Src:TBoard);
var X,Y:Integer;
Begin
For X:=0 To 9 Do
For Y:=0 To 9 Do
Dst[X,Y]:=Src[X,Y];
End;
{显示位置的价值}
Function bwcGetPositionValue1(Brd:TBoard;X,Y,Color:Integer):Integer;
var R:Integer;
Begin
R:=bwcGetEatCount(Brd,X,Y,Color);
bwcGetPositionValue1:=R;
End;

Function bwcGetPositionValue2(Brd:TBoard;bX,bY,Color:Integer):Integer;
var R,R2,X,Y,AddValue,Color2:Integer;
TempBrd,TempBrd2:TBoard;
AngleValue:Array[0..1]Of Array[0..1]Of Integer;
Begin
bwcCopyBoard(TempBrd,Board);
R:=0;
AddValue:=0;
If bwcGetEatCount(TempBrd,bX,bY,Color)>0 Then
Begin

AddValue:=200;

For X:=0 To 1 Do
For Y:=0 To 1 Do
AngleValue[X,Y]:=bwcGetEatCount(Board,X*7+1,Y*7+1,Color);
If((AngleValue[0,0]>0)Or(AngleValue[0,1]>0)Or(AngleValue[1,0]>0)Or(AngleValue[1,1]>0)) Then
AddValue:=400;

bwcPutChess(TempBrd,bX,bY,Color);
For X:=0 To 1 Do
For Y:=0 To 1 Do
AngleValue[X,Y]:=bwcGetEatCount(TempBrd,X*7+1,Y*7+1,Color);
If((AngleValue[0,0]>0)Or(AngleValue[0,1]>0)Or(AngleValue[1,0]>0)Or(AngleValue[1,1]>0)) Then
AddValue:=300;

Color2:=(Color+1)mod 2;
For X:=0 To 1 Do
For Y:=0 To 1 Do
AngleValue[X,Y]:=bwcGetEatCount(TempBrd,X*7+1,Y*7+1,Color2);
If((AngleValue[0,0]>0)Or(AngleValue[1,0]>0)Or(AngleValue[1,0]>0)Or(AngleValue[1,1]>0)) Then
AddValue:=100;

R:=10000;

For X:=1 To 8 Do
For Y:=1 To 8 Do
Begin
bwcCopyBoard(TempBrd2,TempBrd);
If bwcGetEatCount(TempBrd2,X,Y,Color2)>0 Then
bwcPutChess(TempBrd2,X,Y,Color2);
R2:=bwcGetChessCount(TempBrd2,Color)-bwcGetChessCount(TempBrd2,Color2);
If R2<R Then
R:=R2;
End;
If R=10000 Then
Begin
bwcGetPositionValue2:=0;
Exit;
End;
End;
bwcGetPositionValue2:=R+AddValue;
End;

Function bwcGetPositionValue(Brd:TBoard;X,Y,Color:Integer;Level:Integer):Integer;
var R:Integer;
Begin
Case Level Of
1:
Begin
R:=bwcGetPositionValue1(Brd,X,Y,Color);
End;
2:
Begin
R:=bwcGetPositionValue2(Brd,X,Y,Color);
End;
End;
bwcGetPositionValue:=R;
End;

Function bwcGetBestPosition(Level:Integer):Integer;
var Values:Array[1..8]Of Array[1..8]Of Integer;
X,Y,I:Integer;
BestValue,BestCount:Integer;
BestPosition:Array Of TPoint;
Begin
For X:=1 To 8 Do
For Y:=1 To 8 Do
Values[X,Y]:=bwcGetPositionValue(Board,X,Y,1,Level);
BestValue:=0;
For X:=1 To 8 Do
For Y:=1 To 8 Do
If Values[X,Y]>BestValue Then
BestValue:=Values[X,Y];
BestCount:=0;
For X:=1 To 8 Do
For Y:=1 To 8 Do
If Values[X,Y]=BestValue Then
BestCount:=BestCount+1;
SetLength(BestPosition,BestCount);
BestCount:=0;
For X:=1 To 8 Do
For Y:=1 To 8 Do
If Values[X,Y]=BestValue Then
Begin
BestPosition[BestCount].X:=X;
BestPosition[BestCount].Y:=Y;
BestCount:=BestCount+1;
End;
I:=Random(BestCount);
If I=BestCount THen
I:=I-1;
bwcGetBestPosition:=BestPosition.X+BestPosition.Y*10;
End;

end.
 
干嘛贴这么多的代码？！晕都晕了[:D]
你可以这样来实现：用两个全局变量来保存棋盘的大小（用户选者棋盘时就给它们赋了值），注意设置默认值。
其他地方如：产生棋盘、贴图、等（以这两个变量来操作）就可以不改！
 
我也知道是这么来实现，但是我就是不会，这个程序是我按照别人的文档写的，我就是为了应付毕业设计，你可以加我的qq么？83543424 我给你传我的程序 好么？
 
//实际上我只加了一个(因为是正方形)
......................
var
Grid: Integer =6;//Add by me
frmBWC: TfrmBWC;
....................

procedure TfrmBWC.RadioButton1Click(Sender: TObject);//6*6
begin
GRid := 6;
bwcInit;
bwcClearBoard;
NewGame(BWC_VS);
end;

procedure TfrmBWC.RadioButton2Click(Sender: TObject);//8*8
begin
GRid := 8;
bwcInit;
bwcClearBoard;
NewGame(BWC_VS);
end;
//其它要用到Grid的单元加上uses untBWC;
//表示为棋盘大小的8改为Grid就可以了
ok,测试通过!//不过还有些没考虑到的地方,没法,没耐心看,抱歉!
 
接受答案了.
 
您必须登录或注册才可回复。

Similar threads

年
关于根据位图做出不规则Form(很简单，帮我加个注释就行了)(200分)
回复
8
查看
275
年轻和尚
年
J
image的移动的问题，请高手指点！！(50分)
回复
2
查看
169
zhang_yz6666
Z
E
为什么这个点不在点的地方在最低下？我用的是破解的试用版＋delphi6.0(40分)
回复
10
查看
406
esri
E
L
图像的反白？？？(0分)
回复
6
查看
168
Laird
L
鲁
请教大家：这句为什么老通过不了？(5分)
回复
3
查看
181
zw84611
Z
后退
顶部