interface

uses windows, Messages;
procedure Start();
procedure AutoPlay(pa, pb: TPoint);
procedure clearone; // 实现单消
procedure addSpeed; // 去掉消除动画，实现加速
procedure subSpeed; //回复原来速度

type // 定义两个数据类型
  twoXy = array [1 .. 2] of TPoint;
  QP_Array = Array [1 .. 8, 1 .. 25] of byte; //存储棋盘数据

var
  ChessData: QP_Array; //棋盘数据
  sitBase: array [0 .. 3] of Dword = (
    坐0号桌时棋盘基址,
    坐1号桌时棋盘基址
    坐2号桌时棋盘基址
    坐3号桌时棋盘基址
  );
Function TestChess(qp1: QP_Array): bool;
Function GetPoint(): twoXy;
function GetSitNum(): Dword;

// 当前棋盘数组
implementation

// 游戏开局
procedure Start();
var
  Gameh: HWND;
begin
  Gameh := FindWindow(nil, '对对碰角色版');
  // 模拟鼠标单击
  SendMessage(Gameh, Messages.WM_LBUTTONDOWN, 0, $0180017A); // 按下
  SendMessage(Gameh, Messages.WM_LBUTTONUP, 0, $0180017A); // 抬起
end;

Function GetSitNum(): Dword;
var
  Gameh: HWND;
  GamePid: Dword;
  GameProcess: THandle;
  SitNum: Dword;
  readByte: Dword;
begin
  Gameh := FindWindow(nil, '对对碰角色版');

// 找进程ID
  GetWindowThreadProcessId(Gameh, GamePid);
  // 获取进程句柄
  GameProcess := OpenProcess(PROCESS_VM_READ or PROCESS_VM_WRITE, False,
    GamePid);
  // 读出座位号
  ReadProcessMemory(GameProcess, Pointer(座位号基址), @SitNum, 4, readByte);
  // 显示座位号
  Result := SitNum;
end;

procedure AutoPlay(pa: TPoint; pb: TPoint);
var
  Gameh: HWND;
  lparam: Dword;
  p1, p2: TPoint;
begin
  Gameh := FindWindow(nil, '对对碰角色版');
  p1.x := 272 + 48 * (pa.x - 1);
  p1.y := 100 + 48 * (pa.y - 1);
  p2.x := 272 + 48 * (pb.x - 1);
  p2.y := 100 + 48 * (pb.y - 1);
  if Gameh <> 0 then
  begin
    lparam := p1.x + p1.y shl 16;
    SendMessage(Gameh, WM_LBUTTONDOWN, 0, lparam); // 鼠标按下
    SendMessage(Gameh, WM_LBUTTONUP, 0, lparam); // 鼠标抬起

lparam := p2.x + p2.y shl 16;
    SendMessage(Gameh, WM_LBUTTONDOWN, 0, lparam); // 鼠标按下
    SendMessage(Gameh, WM_LBUTTONUP, 0, lparam); // 鼠标抬起

end;
end;

procedure clearone; // 实现单消
var
  pxy: twoXy;
begin
  pxy := GetPoint();
  AutoPlay(pxy[1], pxy[2]);
end;

// 更新棋盘数据
procedure upDataChess(); // 读出棋盘数组
var
  Gameh: HWND;
  GamePid: Dword;
  Gamehprocess: THandle;
  readByte: Dword;
begin
  Gameh := FindWindow(nil, '对对碰角色版'); // 获取游戏窗口句柄
  GetWindowThreadProcessId(Gameh, GamePid); // 获取进程ID
  Gamehprocess := OpenProcess(PROCESS_VM_READ or PROCESS_VM_WRITE, False,
    GamePid); // 获取进程句柄
  ReadProcessMemory(Gamehprocess, Pointer(sitBase[GetSitNum]), @ChessData, 200,
    readByte); // 根据坐位号码 读出相应棋盘数据
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

var
  NewSpeed: array [1 .. 5] of byte = ($90,$90,$6A,$01,$90);
  OldSpeed: array [1 .. 5] of byte = ($EB,$02,$33,$C9,$51);
  SleepBase: Dword = $0041E74D;
procedure addSpeed();
var
  Gameh: HWND;
  GamePid: Dword;
  GameProcess: THandle;
  WriteByte: Dword;
begin
  Gameh := FindWindow(nil, '对对碰角色版');
  if Gameh <> 0 then
  begin
    GetWindowThreadProcessId(Gameh, GamePid);
    GameProcess := OpenProcess(windows.PROCESS_ALL_ACCESS, False, GamePid);
    WriteProcessMemory(GameProcess, Pointer(SleepBase), @NewSpeed[1], 5,
      WriteByte);
  end;
end;
procedure subSpeed;
var
  Gameh: HWND;
  GamePid: Dword;
  GameProcess: THandle;
  WriteByte: Dword;
begin
  Gameh := FindWindow(nil, '对对碰角色版');
  if Gameh <> 0 then
  begin
    GetWindowThreadProcessId(Gameh, GamePid);
    GameProcess := OpenProcess(windows.PROCESS_ALL_ACCESS, False, GamePid);
    WriteProcessMemory(GameProcess, Pointer(SleepBase), @OldSpeed[1], 5,
      WriteByte);
  end;
end;
// End Procudure
end.