unit1.~pas

中国象棋的delphi源代码,可实现联机

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    MenuStart: TMenuItem;
    TimerDrawEllipse: TTimer;
    ListView1: TListView;
    N2: TMenuItem;
    N3: TMenuItem;
    X1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure MenuStartClick(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure TimerDrawEllipseTimer(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure N2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1 : TForm1;

  //棋子数组
  mChess: array [1..10,1..9] of string;//敌方棋子为"敌车"等
                                       //我方棋子为"我车"等
                                       //无棋子为"无子"
  //拾子标志(表示已经拾取一个棋子)
  mPickFlag  : boolean;
  //拾起的棋子
  mPickChess : string;
  //拾子的位置(行)
  mPickRow   : integer;
  //拾子的位置(列)
  mPickColumn: integer;

  //走棋方(敌、我、无)
  mWhoPlay   : string;

  //棋盘背景位图对象
  BitmapBG   : TBitmap;
  //棋子位图对象
  BitmapChess: TBitmap;
  //人脸位图对象
  BitmapFace : TBitmap;
  //移动棋子位图对象
  BitmapMoveChess: TBitmap;
  //重绘位图对象(棋子移动时用)
  BitmapRepaint: TBitmap;

  //前一个鼠标移动点的坐标
  PreX,PreY:integer;

implementation

{$R *.dfm}

//响应窗口创建消息(窗口初始化)
procedure TForm1.FormCreate(Sender: TObject);
var
row,column:integer;
begin
  //初始化所有棋子值为'无子'
  for row:=1 to 10  do
    for column:=1 to 9 do
      mChess[row,column]:='无子';

  //初始化走棋方为无
  mWhoPlay:='无';

  //初始化与拾子相关的变量
  mPickFlag:=false;
  mPickChess:='无子';
  mPickRow:=-1;
  mPickColumn:=-1;

  //创建背景位图，并装载棋盘位图
  BitmapBG:=TBitmap.Create();
  BitmapBG.LoadFromFile('棋盘.bmp');

  //创建棋子位图
  BitmapChess:=TBitmap.Create();
  //设置棋子位图的透明属性为True
  BitmapChess.Transparent:=true;
  //设置棋子位图的透明颜色为白色($FFFFFF)
  BitmapChess.TransparentColor:=clWhite;

  //创建人脸位图
  BitmapFace:=TBitmap.Create();
  //设置人脸位图的透明属性为True
  BitmapFace.Transparent:=true;
  //设置人脸位图的透明颜色为白色
  BitmapFace.TransparentColor:=clWhite;

  //创建移动棋子位图
  BitmapMoveChess:=TBitmap.Create();
  //设置移动棋子位图的透明属性为True
  BitmapMoveChess.Transparent:=true;
  //设置移动棋子位图的透明颜色为白色
  BitmapMoveChess.TransparentColor:=clWhite;

  //创建重绘位图对象(棋子移动时用)，并设置其宽度和高度
  BitmapRepaint:=TBitmap.Create();
  BitmapRepaint.Width:=1200;
  BitmapRepaint.Height:=1200;      
end;

//响应菜单"开局"
procedure TForm1.MenuStartClick(Sender: TObject);
var
row,column:integer;
begin
  //清空所有棋子值
  for row:=1 to 10  do
    for column:=1 to 9 do
      mChess[row,column]:='无子';

  //设置敌方棋子值
  mChess[1,1]:='敌车';
  mChess[1,2]:='敌马';
  mChess[1,3]:='敌象';
  mChess[1,4]:='敌士';
  mChess[1,5]:='敌帅';
  mChess[1,6]:='敌士';
  mChess[1,7]:='敌象';
  mChess[1,8]:='敌马';
  mChess[1,9]:='敌车';
  mChess[3,2]:='敌炮';
  mChess[3,8]:='敌炮';
  mChess[4,1]:='敌兵';
  mChess[4,3]:='敌兵';
  mChess[4,5]:='敌兵';
  mChess[4,7]:='敌兵';
  mChess[4,9]:='敌兵';

  //设置我方棋子值
  mChess[10,1]:='我车';
  mChess[10,2]:='我马';
  mChess[10,3]:='我象';
  mChess[10,4]:='我士';
  mChess[10,5]:='我帅';
  mChess[10,6]:='我士';
  mChess[10,7]:='我象';
  mChess[10,8]:='我马';
  mChess[10,9]:='我车';
  mChess[8,2] :='我炮';
  mChess[8,8] :='我炮';
  mChess[7,1] :='我兵';
  mChess[7,3] :='我兵';
  mChess[7,5] :='我兵';
  mChess[7,7] :='我兵';
  mChess[7,9] :='我兵';

  //设置与拾子相关的变量
  mPickFlag:=false;
  mPickChess:='无子';
  mPickRow:=-1;
  mPickColumn:=-1;

  //设置我方先走棋
  mWhoPlay:='我';

  //刷新窗口
  Invalidate();
end;

//响应窗口刷新
procedure TForm1.FormPaint(Sender: TObject);
var
row,column:integer;
begin
  //绘制棋盘背景
  Canvas.Draw(0,0,BitmapBG);
  //把棋盘背景保存到重绘位图对象
  BitmapRepaint.Canvas.Draw(0,0,BitmapBG);

  //绘制所有棋子
  for row:=1 to 10 do
    for column:=1 to 9 do
    begin
      //判断该位置上是否存在棋子
    if(mChess[row,column]<>'无子')then
      begin
        //装载对应的棋子位图文件
        BitmapChess.LoadFromFile(mChess[row,column]+'.bmp');
        //绘制棋子
        Canvas.Draw(column*60-29,row*60-29,BitmapChess);
        //把棋子保存到重绘位图对象
        BitmapRepaint.Canvas.Draw(column*60-29,row*60-29,BitmapChess);
      end;
    end;

  //绘制人脸
  if(mWhoPlay='我')then
  begin
    //装载对应的棋子位图文件
    BitmapFace.LoadFromFile('我方人脸.bmp');
    //绘制人脸
    Canvas.Draw(650,440,BitmapFace);
    //把人脸保存到重绘位图对象
    BitmapRepaint.Canvas.Draw(650,440,BitmapFace);
  end;
  if(mWhoPlay='敌')then
  begin
    //装载对应的棋子位图文件
    BitmapFace.LoadFromFile('敌方人脸.bmp');
    //绘制人脸
    Canvas.Draw(650,140,BitmapFace);
    //把人脸保存到重绘位图对象
    BitmapRepaint.Canvas.Draw(650,140,BitmapFace);
  end;
end;

//响应鼠标左右键下压消息
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
//鼠标落点所在的行号和列号
Row,Column:integer;
//鼠标落点距离棋盘交叉点的距离
Radius:Real;
//允许落子标志
CanDropFlag:boolean;
//车和炮走棋规则判断时需要的变量
Max,Min:integer;
BlankFlag: boolean;
i:integer;
ChessNum:integer;
//列表框项
item: TListItem;
//分出胜负时的
Result : integer;
begin
  //如果单击鼠标左键
  if(Button=mbLeft)then
  begin
    //求鼠标落点的行号
    Row:= y div 60;
    if(y mod 60 >=35)then
      Row:=Row+1;
    //求鼠标落点的列号
    Column:= x div 60;
    if(X mod 60 >=35)then
      Column:=Column+1;
    //如果行号在1-10之间，列号在1-9之间
    if(Row<=10) and (Row>=1) and (Column<=9) and (Column>=1) then
    begin
      //求鼠标落点与对应的棋盘交叉点距离
      Radius:=sqrt(sqr(x-Column*60)+sqr(y-Row*60));
      //如果鼠标落点在棋盘交叉点附近(半径28之内)
      if(Radius<=28) then
      begin
        //处理拾子动作
        if(mPickFlag=false)then
        begin
          //只有当落点有棋子时，才能拾子
          if( mChess[Row,Column]<>'无子')then
          begin
            //只允许拾起自己方的棋子
            if(Pos(mWhoPlay,mChess[Row,Column])<>0)then
            begin
              //设置拾子标志为True
              mPickFlag:=true;
              //保存拾起的棋子值
              mPickChess:=mChess[Row,Column];
              //保存拾起的棋子的行号和列号
              mPickRow:=Row;
              mPickColumn:=Column;
              //装载移动棋子位图
              BitmapMoveChess.LoadFromFile(mPickChess+'.bmp');
              //涮新窗口
              Invalidate();
            end;
          end;
        end
        //处理落子动作
        else
        begin
          //只有当落点无棋子或存在对方棋子时，才能落子
          if (mChess[Row,Column]='无子') or (Pos(mWhoPlay,mChess[Row,Column])=0) then
          begin
            //设置允许落子标志为false
            CanDropFlag:=false;
            //以下为所有棋子的走棋规则
              //象的走棋规则判断
            if(mPickChess='我象') or (mPickChess='敌象')then
					  begin
              //如果是我方的象
              if(mPickChess='我象')then
                //如果走田字、中央无子且不越界时
                if(abs(mPickRow-Row)=2) and (abs(mPickColumn-Column)=2) and (mChess[(mPickRow+Row)div 2,(mPickColumn+Column)div 2]='无子') and (Row>=6) then
              	  CanDropFlag:=true;
              //如果是敌方的象
              if(mPickChess='敌象')then
                //如果走田字、中央无子且不越界时
                if(abs(mPickRow-Row)=2) and (abs(mPickColumn-Column)=2) and (mChess[(mPickRow+Row)div 2,(mPickColumn+Column)div 2]='无子') and (Row<=5) then
							    CanDropFlag:=true;
            end;

             //兵的走棋规则判断
            if(mPickChess='我兵') or (mPickChess='敌兵')then
            begin
              //如果是我方的兵
              if(mPickChess='我兵')then
              begin
                //当没过界时
                if(mPickRow>=6)then
                  if(Row=mPickRow-1) and (Column=mPickColumn)then
                    CanDropFlag:=true;
                //当已经过界时
                if(mPickRow<=5)then
                begin
                  //横着走
                  if(Row=mPickRow) and (Abs(Column-mPickColumn)=1)then
                    CanDropFlag:=true;
                  //竖着走(往前走)
                  if(Column=mPickColumn) and ((Row-mPickRow)=-1)then
                    CanDropFlag:=true;
                end
              end;
              //如果是敌方的兵
              if(mPickChess='敌兵')then
              begin
                //当没过界时
                if(mPickRow<=5)then
                  if(Row=mPickRow+1) and (Column=mPickColumn)then
                    CanDropFlag:=true;
                //当已经过界时
                if(mPickRow>=6)then
                begin
                  //横着走
                  if(Row=mPickRow) and (Abs(Column-mPickColumn)=1)then
                    CanDropFlag:=true;
                  //竖着走(往前走)
                  if(Column=mPickColumn) and ((Row-mPickRow)=1)then
                    CanDropFlag:=true;
                end;
              end;
            end;


             //马的走棋规则判断
            if(mPickChess='我马') or (mPickChess='敌马')then
					  begin
              //如果横着走日字
              if(abs(mPickRow-Row)=1) and (abs(mPickColumn-Column)=2)then
						  begin
                //如果向右走日字
							  if(Column>mPickColumn)then
                begin
                  //判断是否绊马脚
									if(mChess[mPickRow,mPickColumn+1]='无子')then
										CanDropFlag:=true;
                end
                //如果向左走日字
                else
						    begin
                  //判断是否绊马脚
									if(mChess[mPickRow,mPickColumn-1]='无子')then
										CanDropFlag:=true;
                end;
              end;
              //如果竖着走日字
              if(abs(mPickRow-Row)=2) and (abs(mPickColumn-Column)=1)then
						  begin
                //如果向下走日字
							  if(Row>mPickRow)then
                begin
                  //判断是否绊马脚
                  if(mChess[mPickRow+1,mPickColumn]='无子')then
                    CanDropFlag:=true;
                end
                //如果向上走日字
                else
                begin
                  //判断是否绊马脚
                  if(mChess[mPickRow-1,mPickColumn]='无子')then
									  CanDropFlag:=true;
                end;
              end;
            end;

            //车的走棋规则判断
            if(mPickChess='我车') or (mPickChess='敌车')then