|
unit DDPUnit; 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.
|
2023-10-27
2022-08-15
2022-08-17
2022-09-23
2022-08-13
六六分期app的软件客服如何联系？不知道吗？加qq群【895510560】即可！标题：六六分期
今天小编告诉大家如何处理win10系统火狐flash插件总是崩溃的问题，可能很多用户都不知
今天小编告诉大家如何对win10系统删除桌面回收站图标进行设置，可能很多用户都不知道
今天小编告诉大家如何对win10系统电脑设置节能降温的设置方法，想必大家都遇到过需要
我们在使用xp系统的过程中,经常需要对xp系统无线网络安装向导设置进行设置，可能很多
今天小编告诉大家如何处理win7系统玩cf老是与主机连接不稳定的问题，可能很多用户都不
电脑对日常生活的重要性小编就不多说了，可是一旦碰到win7系统设置cf烟雾头的问题，很
我们在日常使用电脑的时候，有的小伙伴们可能在打开应用的时候会遇见提示应用程序无法
今天小编告诉大家如何对win7系统打开vcf文件进行设置，可能很多用户都不知道怎么对win
今天小编告诉大家如何对win10系统s4开启USB调试模式进行设置，可能很多用户都不知道怎
请发表评论