//GobangUnit.pas
//mailto:wjhu111@21cn.com
//for Delphi6
unit GobangUnit;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, FuncUnit, ExtCtrls, StdCtrls, Buttons, ComCtrls;
const
cSignInt: array[Boolean] of Integer = (-1, +1);
const
cMapImageCount = 22;
cMapImageList: array[0 .. Pred(cMapImageCount)] of string =
(
{00}' ●', {01}'○', {02}'┌', {03}'┬', {04}'┐',
{05}'├', {06}'┼', {07}'┤', {08}'└', {09}'┴',
{10}'┘', {11}'★', {12}'☆', {13}'┏', {14}'┳',
{15}'┓', {16}'┣', {17}'╋', {18}'┫', {19}'┗',
{20}'┻', {21}'┛'
);
cMapCol = 17;
cMapRow = 17;
const
cMoveTide: array[1 .. 4] of TPoint =
(
{1}(X: 00; Y: +1), //'
{2}(X: +1; Y: +1), //'/'
{3}(X: +1; Y: 00), //'-'
{4}(X: +1; Y: -1) //'\'
);
type
TFormGobang = class(TForm)
ImageGobang: TImage;
BitBtnPlay: TBitBtn;
CheckBoxComputer: TCheckBox;
StatusBarGobang: TStatusBar;
procedure FormCreate(Sender: TObject);
procedure ImageGobangMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ImageGobangMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure BitBtnPlayClick(Sender: TObject);
private
{ Private declarations }
FCurrCol, FCurrRow: Integer; //当前下子坐标
FMouseCol, FMouseRow: Integer; //当前鼠标坐标
FPointList: array[1 .. cMapCol, 1 .. cMapRow] of Integer; //棋盘参数
FCalcParas: array[Boolean, 1 .. 4, 1 .. cMapCol, 1 .. cMapRow] of Integer; //攻防指数
FChessman: Boolean; //下棋方
FMaxParas: Integer; //最佳综合数
FMaxCount: Integer; //最佳综合值
FStepIndex: Integer; //当前步数
FTextHeight: Integer; //字体高度
FTextWidth: Integer; //字体宽度
FAttackMaxCount: array[Boolean] of Integer; //最佳进攻数
FAttackMaxParas: array[Boolean] of Integer; //最佳进攻值
FSumParas: array[1 .. cMapCol, 1 .. cMapRow] of Integer; //综合指数
public
{ Public declarations }
procedure DrawMap; //画棋盘棋子
procedure InitMap; //初始化棋盘棋子
procedure Chessed(X, Y: Integer); //下子
procedure CalcParas; //计算指数
procedure Decide; //电脑下棋
end;
var
FormGobang: TFormGobang;
implementation
{$R *.dfm}
{ TFormGobang }
procedure TFormGobang.CalcParas;
var
I, J, K, T: Integer;
X, Y: Integer;
B, L, W, P: Boolean;
vValue: Integer;
A: array[Boolean] of Integer;
begin
FMaxParas := 0;
FMaxCount := 0;
FAttackMaxCount[False] := 0;
FAttackMaxCount[True] := 0;
FAttackMaxParas[False] := 0;
FAttackMaxParas[True] := 0;
for I := 1 to cMapCol do
for J := 1 to cMapRow do begin
FSumParas[I, J] := 0;
for B := False to True do
for K := 1 to 4 do begin
vValue := 0;
if FPointList[I, J] = -cSignInt[B] then begin
FCalcParas[B, K, I, J] := -1;
Continue;
end else if FPointList[I, J] = cSignInt[B] then begin
FCalcParas[B, K, I, J] := -2;
Continue;
end;
for L := False to True do begin
X := I;
Y := J;
T := 0;
A[L] := 0;
W := True;
P := True;
while T < 4 do begin
Inc(X, cMoveTide[K].x * cSignInt[L]);
Inc(Y, cMoveTide[K].y * cSignInt[L]);
if (X < 1) or (X > cMapCol) then Break;
if (Y < 1) or (Y > cMapRow) then Break;
if FPointList[X, Y] = -cSignInt[B] then Break;
if W and (FPointList[X, Y] = cSignInt[B]) then
Inc(vValue, 100)
else W := False;
if not W and P and (FPointList[X, Y] = 0) then
Inc(A[L], 10)
else P := False;
Inc(vValue);
Inc(T);
end;
end;
if not(0 in [A[False], A[True]]) then
vValue := vValue + A[False] + A[True];
if vValue > 500 then vValue := 0;
if (vValue mod 10) < 4 then vValue := 0;
FCalcParas[B, K, I, J] := vValue;
FSumParas[I, J] := FSumParas[I, J] + vValue;
if FAttackMaxParas[B] < FCalcParas[B, K, I, J] then begin
FAttackMaxParas[B] := FCalcParas[B, K, I, J];
FAttackMaxCount[B] := 1;
end else if FAttackMaxParas[B] = FCalcParas[B, K, I, J] then
Inc(FAttackMaxCount[B]);
end;
if FMaxParas < FSumParas[I, J] then begin
FMaxParas := FSumParas[I, J];
FMaxCount := 1;
end else if FMaxParas = FSumParas[I, J] then
Inc(FMaxCount);
end;
end;
procedure TFormGobang.Chessed(X, Y: Integer);
var
K, T, I, J, vValue: Integer;
L: Boolean;
begin
FCurrCol := X;
FCurrRow := Y;
FPointList[FCurrCol, FCurrRow] := cSignInt[FChessman];
Inc(FStepIndex);
for K := 1 to 4 do
if FCalcParas[FChessman, K, X, Y] >= 400 then begin
vValue := 1;
for L := False to True do begin
T := 0;
I := X;
J := Y;
while T < 4 do begin
Inc(I, cMoveTide[K].x * cSignInt[L]);
Inc(J, cMoveTide[K].y * cSignInt[L]);
if (I < 1) or (I > cMapCol) then Break;
if (J < 1) or (J > cMapRow) then Break;
if FPointList[I, J] <> cSignInt[FChessman] then Break;
Inc(vValue);
Inc(T);
end;
end;
if vValue = 5 then begin
FChessman := not FChessman;
DrawMap;
MessageDlg(Format('%s胜利', [cMapImageList[
Integer(Iif(FChessman, 1, 0))]]), mtInformation, [mbOk], 0);
ImageGobang.Enabled := False;
Exit;
end;
end;
FChessman := not FChessman;
DrawMap;
CalcParas;
if CheckBoxComputer.Checked and FChessman then Decide;
end;
procedure TFormGobang.DrawMap;
var
I, J, vImageIndex: Integer;
vMapText: string;
begin
vMapText := '';
for J := 1 to cMapRow do begin
for I := 1 to cMapCol do begin
if FPointList[I, J] <> 0 then
if (I = FCurrCol) and (J = FCurrRow )then
vImageIndex := Iif(FChessman, 12, 11)
else if FPointList[I, J] = 1 then
vImageIndex := 0
else vImageIndex := 1
else if I = 1 then
if J = 1 then
vImageIndex := 2
else if J = cMapRow then
vImageIndex := 8
else vImageIndex := 5
else if I = cMapCol then
if J = 1 then
vImageIndex := 4
else if J = cMapRow then
vImageIndex := 10
else vImageIndex := 7
else if J = 1 then
vImageIndex := 3
else if J = cMapRow then
vImageIndex := 9
else vImageIndex := 6;
if (I = FMouseCol) and (J = FMouseRow) and (vImageIndex in [2..10]) then
Inc(vImageIndex, 11);
vMapText := vMapText + cMapImageList[vImageIndex];
end;
vMapText := vMapText + #13#10;
end;
TextToCanvas(vMapText, ImageGobang.Canvas, Point(0, 0));
end;
procedure TFormGobang.InitMap;
begin
FStepIndex := 0;
FillChar(FPointList, SizeOf(FPointList), 0);
CalcParas;
end;
procedure TFormGobang.FormCreate(Sender: TObject);
begin
ImageGobang.Canvas.Font.Name := '宋体';
ImageGobang.Canvas.Font.Size := 19;
FTextHeight := ImageGobang.Canvas.TextHeight('你');
FTextWidth := ImageGobang.Canvas.TextWidth('好');
DoubleBuffered := True;
FChessman := False;
ImageGobang.Width := cMapCol * FTextWidth;
ImageGobang.Height := cMapRow * FTextHeight;
InitMap;
DrawMap;
end;
procedure TFormGobang.ImageGobangMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
vCol, vRow: Integer;
begin
if Button = mbRight then Exit;
vCol := X div FTextWidth + 1;
vRow := Y div FTextHeight + 1;
if (vCol < 1) or (vCol > cMapCol) then Exit;
if (vRow < 1) or (vRow > cMapRow) then Exit;
if FPointList[vCol, vRow] <> 0 then begin
Beep;
Exit;
end;
Chessed(vCol, vRow);
end;
procedure TFormGobang.ImageGobangMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
var
vCol, vRow: Integer;
begin
vCol := X div FTextWidth + 1;
vRow := Y div FTextHeight + 1;
if (vCol < 1) or (vCol > cMapCol) then Exit;
if (vRow < 1) or (vRow > cMapRow) then Exit;
if (vRow = FMouseRow) and (vRow = FMouseCol) then Exit;
FMouseRow := vRow;
FMouseCol := vCol;
DrawMap;
StatusBarGobang.SimpleText :=
Format('X:%.2d, Y:%.2d, S:%.2d', [vCol, vRow, FStepIndex]);
end;
procedure TFormGobang.Decide;
var
I, J, K, T, M: Integer;
begin
if (FAttackMaxParas[not FChessman] >= FAttackMaxParas[FChessman]) and
(FAttackMaxParas[FChessman] < 400) then begin
///////Begin 考虑防御指数
M := 0;
T := Random(FAttackMaxCount[not FChessman]);
for J := 1 to cMapRow do
for I := 1 to cMapCol do
for K := 1 to 4 do
if FAttackMaxParas[not FChessman] <=
FCalcParas[not FChessman, K, I, J] then
if M >= T then
begin
Chessed(I, J);
Exit;
end else Inc(M);
///////End 考虑防御指数
end else if (FAttackMaxParas[FChessman] > 310)
or (FAttackMaxParas[FChessman] >= FAttackMaxParas[not FChessman])
or (FAttackMaxParas[not FChessman] < 210) then begin
///////Begin 考虑进攻指数
M := 0;
T := Random(FAttackMaxCount[FChessman]);
for J := 1 to cMapRow do
for I := 1 to cMapCol do
for K := 1 to 4 do
if FAttackMaxParas[FChessman] <=
FCalcParas[FChessman, K, I, J] then
if M >= T then
begin
Chessed(I, J);
Exit;
end else Inc(M);
///////End 考虑进攻指数
end else begin
///////Begin 考虑综合指数
M := 0;
T := Random(FMaxCount);
for J := 1 to cMapRow do
for I := 1 to cMapCol do
if FMaxParas = FSumParas[I, J] then
if M >= T then
begin
Chessed(I, J);
Exit;
end else Inc(M);
///////End 考虑综合指数
end;
end;
procedure TFormGobang.BitBtnPlayClick(Sender: TObject);
begin
ImageGobang.Enabled := True;
InitMap;
DrawMap;
if CheckBoxComputer.Checked and FChessman then Decide;
end;
end.
//GobangUnit.dfm
object FormGobang: TFormGobang
Left = 178
Top = 27
Width = 451
Height = 504
Caption = 'FormGobang'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object ImageGobang: TImage
Left = 8
Top = 24
Width = 425
Height = 426
OnMouseDown = ImageGobangMouseDown
OnMouseMove = ImageGobangMouseMove
end
object BitBtnPlay: TBitBtn
Left = 115
Top = 2
Width = 75
Height = 20
Caption = 'Play'
TabOrder = 0
OnClick = BitBtnPlayClick
end
object CheckBoxComputer: TCheckBox
Left = 8
Top = 0
Width = 97
Height = 17
Caption = 'Computer'
Checked = True
State = cbChecked
TabOrder = 1
end
object StatusBarGobang: TStatusBar
Left = 0
Top = 458
Width = 443
Height = 19
Panels = <>
SimplePanel = True
end
end
//FuncUnit.pas
unit FuncUnit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
function Iif(mBool: Boolean; mDataA: Variant; mDataB: Variant): Variant;
procedure TextToCanvas(mText: string; mCanvas: TCanvas; mMove: TPoint);
implementation
function Iif(mBool: Boolean; mDataA: Variant; mDataB: Variant): Variant;
begin
if mBool then
Result := mDataA
else Result := mDataB;
end; { Iif }
procedure TextToCanvas(mText: string; mCanvas: TCanvas; mMove: TPoint);
var
I: Integer;
vTextHeight: Integer;
begin
with TStringList.Create do try
Text := mText;
vTextHeight := mCanvas.TextHeight(' );
for I := 0 to Pred(Count) do
mCanvas.TextOut(mMove.X, mMove.Y + vTextHeight * I, Strings[I]);
finally
Free;
end;
end; { TextToCanvas }
end.
//GobangApp.dpr
program GobangApp;
uses
Forms,
GobangUnit in 'GobangUnit.pas' {FormGobang},
FuncUnit in 'FuncUnit.pas';
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TFormGobang, FormGobang);
Application.Run;
end.