• 设为首页
  • 点击收藏
  • 手机版
    手机扫一扫访问
    迪恩网络手机版
  • 关注官方公众号
    微信扫一扫关注
    公众号
登陆 注册

Delphi–我的代码之简单五子棋

原作者: [db:作者] 来自: [db:来源] 收藏 邀请

技术交流,DH讲解.

今天来实现一个简单的五子棋,直接用GDI来画的一个游戏.
首先我们来想下怎么存放数据,哪些地方是白棋,哪些地方是黑棋,哪些地方没有下棋?
对,我们用一个二维数组,如果数组中某一个位置的值为0代表没有下棋,为1代表是白棋,为2代表是黑棋.
好就这么说定了,为了使用方便,我们打算做成一个控件,因为要画界面所以我们从TGraphicControl继承下来.
看一下类定义的代码:

Type
  TLastPlayer= (LpP1, LpP2);
  TGameEvent= Procedure(S: TObject; P: TLastPlayer) Of Object;

  TFiveGame= Class(TGraphicControl)
  Private
    // 如果是空,就是0,白棋就是1,黑棋就是2
    FData: Array Of Array Of Byte;
    // 棋盘的长和宽
    FRows, FColumns: Integer;
    // 格子的宽度/
    FCellWidth: Integer;
    // 是否自动大小
    FAutoSize: Boolean;
    // 棋盘线条的颜色.
    FLineColor: TColor;
    // 2个选手的颜色
    FPlayerOneColor: TColor;
    FPlayerTwoColor: TColor;
    // 边距
    FHDistance, FVDistance: Integer;
    // 上次操作的选手
    FLastPlayer: TLastPlayer;
    // 三个事件
    FWinEvent: TGameEvent;
    FErrorEvent: TGameEvent;
    FSuccessEvent: TGameEvent;
    Procedure SetRows(Const Value: Integer);
    Procedure SetColumns(Const Value: Integer);
    Procedure SetCellWidth(Const Value: Integer);
    Procedure SetAutoSize(Const Value: Boolean);
    Procedure SetLineColor(Const Value: TColor);
    Procedure SetPlayerOneColor(Const Value: TColor);
    Procedure SetPlayerTwoColor(Const Value: TColor);
    Procedure SetHDistance(Const Value: Integer);
    Procedure SetVDistance(Const Value: Integer);
    Procedure Paint; Override;
    Function AddChessMan(X, Y, V: Integer): Boolean;
    Procedure MyButtonDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    Function Judge(X, Y, V: Integer): Boolean;
  Protected

  Public
    Constructor Create(AOwner: TComponent); Override;
    Destructor Destroy; Override;
    //
    Procedure ReStart;
    Function AddP1Chessman(X, Y: Integer): Boolean;
    Function AddP2Chessman(X, Y: Integer): Boolean;
  Published
    Property Rows: Integer Read FRows Write SetRows;
    Property Columns: Integer Read FColumns Write SetColumns;
    Property CellWidth: Integer Read FCellWidth Write SetCellWidth;
    Property AutoSize: Boolean Read FAutoSize Write SetAutoSize;
    Property LineColor: TColor Read FLineColor Write SetLineColor;
    Property PlayerOneColor
      : TColor Read FPlayerOneColor Write SetPlayerOneColor;
    Property PlayerTwoColor
      : TColor Read FPlayerTwoColor Write SetPlayerTwoColor;
    Property HDistance: Integer Read FHDistance Write SetHDistance;
    Property VDistance: Integer Read FVDistance Write SetVDistance;
    Property WinEvent: TGameEvent Read FWinEvent Write FWinEvent;
    Property LastPlayer: TLastPlayer Read FLastPlayer Write FLastPlayer;
    Property ErrorEvent: TGameEvent Read FErrorEvent Write FErrorEvent;
    Property SuccessEvent: TGameEvent Read FSuccessEvent Write FSuccessEvent;
  End;

我们这样定义了一个类,接下来看看怎么实现它的:

{ TFiveGame }
// 增加一颗棋子
Function TFiveGame.AddChessMan(X, Y, V: Integer): Boolean;
Begin
  Result:= False;
  If (X< 0)Or (Y< 0)Or (X> Columns- 1)Or (Y> Rows- 1) Then
    Exit;
  If FData[X, Y]<> 0 Then
    Exit;
  FData[X, Y]:= Byte(V);
  Result:= True;
End;

// 一号选手增加棋子
Function TFiveGame.AddP1Chessman(X, Y: Integer): Boolean;
Begin
  Result:= AddChessMan(X, Y, 1);
End;

// 二号选手增加棋子
Function TFiveGame.AddP2Chessman(X, Y: Integer): Boolean;
Begin
  Result:= AddChessMan(X, Y, 2)
End;

Constructor TFiveGame.Create(AOwner: TComponent);
Begin
  Inherited;
  // 初始化
  FAutoSize:= False;
  FRows:= 5;
  FColumns:= 5;
  FCellWidth:= 30;
  FLineColor:= ClRed;
  FPlayerOneColor:= ClBlack;
  FPlayerTwoColor:= ClYellow;
  FHDistance:= 20;
  FVDistance:= 20;
  FLastPlayer:= LpP2;
  SetLength(FData, FRows, FColumns);
  // 要响应鼠标,必须加上这个
  ControlStyle:= ControlStyle+ [CsReplicatable, CsCaptureMouse, CsClickEvents];
  Self.OnMouseDown:= MyButtonDown;
End;

Destructor TFiveGame.Destroy;
Begin

  Inherited;
End;

// 判断是否胜利
Function TFiveGame.Judge(X, Y, V: Integer): Boolean;
Var
  C1, C2: Integer;
  X1, Y1: Integer;

  Procedure Reset;
  Begin
    C1:= 0;
    C2:= 0;
    X1:= X;
    Y1:= Y;
  End;

Begin
  Result:= True;
  // 这个编译指令是代码折叠,但是D7以及之前版本没有这个编译指令.不要惊恐
  // 横向
  {$IFDEF D7UP}
  {$REGION '横向'}
  {$ENDIF}
  Begin
    Reset;
    // 向左
    Dec(X1);
    While X1>= 0 Do
    Begin
      If FData[X1, Y]<> V Then
        Break;
      Inc(C1);
      If C1= 4 Then
        Exit;
      Dec(X1);
    End;
    // 向右
    X1:= X+ 1;
    While X1< Columns Do
    Begin
      If FData[X1, Y]<> V Then
        Break;
      Inc(C2);
      If C1+ C2= 4 Then
        Exit;
      Inc(X1);
    End;
  End;
  {$IFDEF D7UP}
  {$ENDREGION}
  // 竖向
  {$REGION '竖向'}
  {$ENDIF}
  Begin
    Reset;
    // 向上
    Dec(Y1);
    While Y1>= 0 Do
    Begin
      If FData[X, Y1]<> V Then
        Break;
      Inc(C1);
      If C1= 4 Then
        Exit;
      Dec(Y1);
    End;
    // 向下
    Y1:= Y+ 1;
    While Y1< Rows Do
    Begin
      If FData[X, Y1]<> V Then
        Break;
      Inc(C2);
      If C1+ C2= 4 Then
        Exit;
      Inc(Y1);
    End;
  End;
  {$IFDEF D7UP}
  {$ENDREGION}
  // 斜向1
  {$REGION '斜向1'}
  {$ENDIF}
  Begin
    Reset;
    Dec(X1);
    Dec(Y1);
    While (X1>= 0)And (Y1>= 0) Do
    Begin
      If FData[X1, Y1]<> V Then
        Break;
      Inc(C1);
      If C1= 4 Then
        Exit;
      Dec(X1);
      Dec(Y1);
    End;
    X1:= X+ 1;
    Y1:= Y+ 1;
    While (X1< Columns)And (Y1< Rows) Do
    Begin
      If FData[X1, Y1]<> V Then
        Break;
      Inc(C2);
      If C1+ C2= 4 Then
        Exit;
      Inc(X1);
      Inc(Y1)
    End;
  End;
  {$IFDEF D7UP}
  {$ENDREGION}
  // 斜向2
  {$REGION '斜向2'}
  {$ENDIF}
  Begin
    Reset;
    Dec(X1);
    Inc(Y1);
    While (X1>= 0)And (Y1< Rows) Do
    Begin
      If FData[X1, Y1]<> V Then
        Break;
      Inc(C1);
      If C1= 4 Then
        Exit;
      Dec(X1);
      Inc(Y1);
    End;
    X1:= X+ 1;
    Y1:= Y- 1;
    While (X1< Columns)And (Y1>= 0) Do
    Begin
      If FData[X1, Y1]<> V Then
        Break;
      Inc(C2);
      If C1+ C2= 4 Then
        Exit;
      Inc(X1);
      Dec(Y1);
    End;
  End;
  {$IFDEF D7UP}
  {$ENDREGION}
  {$ENDIF}
  Result:= False;
End;

Procedure TFiveGame.MyButtonDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
Var
  I, J, K: Integer;
  B: Boolean;
Begin
  // 不是左键
  If Button<> MbLeft Then
    Exit;
  // 计算x,y的位置
  If (X< HDistance)Or (X> HDistance+ Columns* CellWidth) Then
    Exit;
  If (Y< VDistance)Or (Y> VDistance+ Rows* CellWidth) Then
    Exit;
  I:= (X- HDistance)Div CellWidth;
  J:= (Y- VDistance)Div CellWidth;
  // 加棋子
  Case FLastPlayer Of
    LpP1:
      Begin
        B:= AddP2Chessman(I, J);
        If B Then
          FLastPlayer:= LpP2
      End;
    LpP2:
      Begin
        B:= AddP1Chessman(I, J);
        If B Then
          FLastPlayer:= LpP1
      End;
  End;
  // 结果处理
  If B Then
  Begin
    Invalidate;
    If Assigned(FSuccessEvent) Then
      FSuccessEvent(Self, FLastPlayer);
    If Judge(I, J, Ord(FLastPlayer)+ 1) Then
      If Assigned(FWinEvent) Then
        FWinEvent(Self, FLastPlayer);
  End
  Else
    If Assigned(FErrorEvent) Then
      FErrorEvent(Self, FLastPlayer);
End;

Procedure TFiveGame.Paint;

  Procedure DrawBkg;
  Var
    I: Integer;
    OldColor: TColor;
  Begin
    With Canvas Do
    Begin
      OldColor:= Pen.Color;
      Pen.Color:= LineColor;
      Rectangle(HDistance, VDistance, HDistance+ Columns* CellWidth,
        VDistance+ Rows* CellWidth);
      For I:= 1 To Columns- 1 Do
      Begin
        MoveTo(HDistance+ I* CellWidth, VDistance);
        LineTo(HDistance+ I* CellWidth, VDistance+ Rows* CellWidth);
      End;
      For I:= 1 To Rows- 1 Do
      Begin
        MoveTo(HDistance, VDistance+ I* CellWidth);
        LineTo(HDistance+ Columns* CellWidth, VDistance+ I* CellWidth);
      End;
      Pen.Color:= OldColor;
    End;
  End;

  Procedure DrawChessMan(X, Y, V: Integer);
  Var
    C1, C2: TColor;
  Begin
    With Canvas Do
    Begin
      C1:= Brush.Color;
      C2:= Pen.Color;
      Case V Of
        1:
          Brush.Color:= PlayerOneColor;
        2:
          Brush.Color:= PlayerTwoColor;
      End;
      Pen.Color:= Brush.Color;
      Ellipse(HDistance+ X* CellWidth+ 1, VDistance+ Y* CellWidth+ 1,
        HDistance+ (X+ 1)* CellWidth- 1, VDistance+ (Y+ 1)* CellWidth- 1);
      Pen.Color:= C2;
      Brush.Color:= C1;
    End;
  End;

Var
  J: Integer;
  K: Integer;
Begin
  //如果自动大小 就调整大小
  If AutoSize Then
  Begin
    Width:= HDistance* 2+ Columns* CellWidth;
    Height:= VDistance* 2+ Rows* CellWidth;
  End;
  // 画棋盘
  DrawBkg;
  // 画棋子
  For J:= 0 To Rows- 1 Do
    For K:= 0 To Columns- 1 Do
      If FData[J, K]<> 0 Then
        DrawChessMan(J, K, FData[J, K]);

End;

Procedure TFiveGame.ReStart;
Var
  I: Integer;
  J: Integer;
Begin
  For I:= 0 To Rows- 1 Do
    For J:= 0 To Columns- 1 Do
      FData[I, J]:= 0;
  Invalidate;
End;

Procedure TFiveGame.SetAutoSize(Const Value: Boolean);
Begin
  If FAutoSize= Value Then
    Exit;
  FAutoSize:= Value;
  Invalidate;
End;

Procedure TFiveGame.SetCellWidth(Const Value: Integer);
Begin
  If FCellWidth= Value Then
    Exit;
  FCellWidth:= Value;
  Invalidate;
End;

Procedure TFiveGame.SetColumns(Const Value: Integer);
Begin
  If FColumns= Value Then
    Exit;
  FColumns:= Value;
  SetLength(FData, FRows, FColumns);
  Invalidate;
End;

Procedure TFiveGame.SetHDistance(Const Value: Integer);
Begin
  If FHDistance= Value Then
    Exit;
  FHDistance:= Value;
  Invalidate;
End;

Procedure TFiveGame.SetPlayerOneColor(Const Value: TColor);
Begin
  If FPlayerOneColor= Value Then
    Exit;
  FPlayerOneColor:= Value;
  Invalidate;
End;

Procedure TFiveGame.SetLineColor(Const Value: TColor);
Begin
  If FLineColor= Value Then
    Exit;
  FLineColor:= Value;
  Invalidate;
End;

Procedure TFiveGame.SetPlayerTwoColor(Const Value: TColor);
Begin
  If FPlayerTwoColor= Value Then
    Exit;
  FPlayerTwoColor:= Value;
  Invalidate;
End;

Procedure TFiveGame.SetRows(Const Value: Integer);
Begin
  If FRows= Value Then
    Exit;
  FRows:= Value;
  SetLength(FData, FRows, FColumns);
  Invalidate;
End;

Procedure TFiveGame.SetVDistance(Const Value: Integer);
Begin
  If FVDistance= Value Then
    Exit;
  FVDistance:= Value;
  Invalidate;
End;

要想把这个类加到控件面板上面去就需要再添加一个Register全局函数,我这里没有添加,所以也不演示那句话了.

类给出来了,我们看看怎么使用这个类.
定义一个该类的对象:

FiveGame:TFiveGame;

窗体创建的时候的时候,实例化这个对象:

procedure TForm1.FormCreate(Sender: TObject);
begin
  FiveGame:=TFiveGame.Create(Self);
  FiveGame.Parent:=Self;
  FiveGame.Align:=alClient;
  FiveGame.WinEvent:=OnWin;
  FiveGame.ErrorEvent:=Onerror;
  FiveGame.SuccessEvent:=OnSuccess;
end;

窗体结束的时候不要忘记释放这个对象哟.代码我就不贴了,给出一个完整代码下载的链接吧.

下载地址:点这里

代码很简单,也很不完善,打算有空加入人机对战和联网对战,然后界面再改漂亮一些吧,比如用贴图或者用DX来弄.
这里只是一个抛砖引玉吧.

我是DH,今天到这里.

鲜花
握手
雷人
路过
鸡蛋
该文章已有0人参与评论

请发表评论

全部评论

专题导读
More+
上一篇：
MATLAB 与 Excel 接口发布时间：2022-07-18
下一篇：
matlab+中文字体设计，有搞头没有？ 有搞头发布时间：2022-07-18
热门推荐
More+
热门话题
More+
阅读排行榜

扫描微信二维码

查看手机版网站

随时了解更新最新资讯

139-2527-9053

在线客服（服务时间 9:00～18:00）

在线QQ客服
地址：深圳市南山区西丽大学城创智工业园
电邮：jeky_zhao#qq.com
移动电话：139-2527-9053

Powered by 互联科技 X3.4© 2001-2213 极客世界.|Sitemap