打开GameProc 单元
把 游戏开局 读坐位号 读棋盘数组 交换点1与点2 全部集成封装到相应的函数里
uses windows,messages,sysutils;
///
type
QP_Array=Array[1..8,1..25] of byte;
twoxy=array[1..2] of Tpoint;
ChessData:QP_Array; //当前棋盘数组
procedure Start; //游戏开局
procedure upDataChess(); //读出棋盘数组
//交换2点
procedure autoPlay(pa,pb:TPoint); //鼠标模拟 交换点1与点2
前边我们已经 整理 Start,autoPlay,upDataChess 这几个功能函数到GameProc
这一节课我们再 写一个函数 用来获取 用于消除 的2 点坐标的参数
这个函数写好了,,我们的外挂就完成95%了
于是我们写一个函数GetPoint用于计算 棋盘内是否存在2个可交换点
在这之前我们改一下 这里 autoplay函数
p1.X:=272+48*pa.X-24; p1.Y:=99+48*pa.Y-24;
p2.X:=272+48*pb.X-24; p2.Y:=99+48*pb.Y-24;
procedure clearone; //实现单消
var
pxy:twoxy;
begin
pxy:=GetPoint();
AutoPlay(pxy[1],pxy[2]);
end;
//获取交换点
Function GetPoint():twoXy;
var
x,y,t1:byte;
qp:QP_Array;
begin
///
for x:=1 to 8 do
for y:=1 to 7 do
begin
updataChess;
qp:=ChessData;
t1:=qp[x][y]; qp[x][y]:=qp[x][y+1]; qp[x][y+1]:=t1;
if TestChess(qp) then begin
result[1].X:=x;
result[1].Y:=y;
result[2].X:=x;
result[2].Y:=y+1; exit;end;
end;//end for
for y:=1 to 8 do
for x:=1 to 7 do
begin
updataChess;
qp:=ChessData;
t1:=qp[x][y]; qp[x][y]:=qp[x+1][y]; qp[x+1][y]:=t1;
if TestChess(qp) then begin
result[1].X:=x;
result[1].Y:=y;
result[2].X:=x+1;
result[2].Y:=y; exit;end;
end;//end for
end; //end Function
//
Function TestChess(qp1:QP_Array):bool; //测试交换过的棋盘 内是否有 三个相同棋子相连 3
var
r1,x,y:byte;
begin
Result:=false;
for y:=1 to 8 do //行坐标
begin
r1:=1;
for x:=1 to 7 do //列坐标
begin
if qp1[x][y]=qp1[x+1][y] then begin r1:=r1+1 ;
if r1>=3 then begin Result:=true;exit;end;
end
else r1:=1;
end;
end;
/
//遍历 1-8 列 看是否有 3子 相连的
for x:=1 to 8 do //行坐标
begin
r1:=1;
for y:=1 to 7 do //列坐标
begin
if qp1[x][y]=qp1[x][y+1] then begin r1:=r1+1 ;
if r1>=3 then begin Result:=true;exit;end;
end
else r1:=1;
end;
end;
end; //end function
//
procedure clearone; //实现单消
var
pxy:twoxy;
begin
pxy:=GetPoint();
AutoPlay(pxy[1],pxy[2]);
end;
//获取交换点
Function GetPoint():twoXy; //获取可交换的2个点
var
x,y,t1:byte;
qp:QP_Array;
begin
///
for x:=1 to 8 do //1-8列
for y:=1 to 7 do // 遍历某列
begin
updataChess; //更新棋盘数据
qp:=ChessData;
t1:=qp[x][y]; qp[x][y]:=qp[x][y+1]; qp[x][y+1]:=t1; //交换相临棋子
if TestChess(qp) then begin
result[1].X:=x;
result[1].Y:=y;
result[2].X:=x;
result[2].Y:=y+1; exit;end;
end;//end for
for y:=1 to 8 do
for x:=1 to 7 do
begin
updataChess; //更新棋盘数据
qp :=ChessData; //
t1:=qp[x][y]; qp[x][y]:=qp[x+1][y]; qp[x+1][y]:=t1; //交换相临的2点
if TestChess(qp) then begin //如果交换后的棋盘 存在 三个相同的棋子相连
result[1].X:=x;
result[1].Y:=y;
result[2].X:=x+1;
result[2].Y:=y; exit;end;
end;//end for
end; //end Function
//
Function TestChess(qp1:QP_Array):bool; //测试交换过的棋盘 内是否有 三个相同棋子相连 3
var
r1,x,y:byte;
begin
Result:=false;
for y:=1 to 8 do //1-8行坐标
begin
r1:=1;
for x:=1 to 7 do //Y列坐标
begin
if qp1[x][y]=qp1[x+1][y] then begin r1:=r1+1 ; //累计相同棋子数
if r1>=3 then begin Result:=true;exit;end;
end
else r1:=1; //初始化累计 1
end;
end;
/
//遍历 1-8 列 看是否有 3子 相连的
for x:=1 to 8 do //
begin
r1:=1;
for y:=1 to 7 do //列坐标
begin
if qp1[x][y]=qp1[x][y+1] then begin r1:=r1+1 ; //累计 相同的棋子数
if r1>=3 then begin Result:=true;exit;end; //
end
else r1:=1; //如果相临棋子 不同,则初如化累计值
end;
end;
end; //end function