QQ连连看 for Delphi 源码
2008-02-10 13:27
344 查看
kbhook.DLL
library kbhook;
{ Important note about DLL memory management: ShareMem must be the
first unit in your library's USES clause AND your project's (select
Project-View Source) USES clause if your DLL exports any procedures or
functions that pass strings as parameters or function results. This
applies to all strings passed to and from your DLL--even those that
are nested in records and classes. ShareMem is the interface unit to
the BORLNDMM.DLL shared memory manager, which must be deployed along
with your DLL. To avoid using BORLNDMM.DLL, pass string information
using PChar or ShortString parameters. }
uses
windows;
var
hHk: HHOOK;
BFirst:Boolean=True;
//{$R *.res}
procedure ModMemData();
var
pData: pointer;
dwOldProtect: DWORD;
mbi_thunk: TMemoryBasicInformation;
begin
pData := pointer($00403296);
//查询页信息。
VirtualQuery(pData, mbi_thunk, sizeof(MEMORY_BASIC_INFORMATION));
//改变页保护属性为读写。
VirtualProtect(mbi_thunk.BaseAddress, mbi_thunk.RegionSize,
PAGE_READWRITE, mbi_thunk.Protect);
//清零。
PByte(pData)^ := 0;
//恢复页的原保护属性。
VirtualProtect(mbi_thunk.BaseAddress, mbi_thunk.RegionSize,
mbi_thunk.Protect, dwOldProtect);
end;
function keyHookProc(nCode: Integer; WParam: WPARAM; LParam: LPARAM): LRESULT;
stdcall;
const
_KeyPressMask = $80000000;
begin
Result := 0;
if nCode < 0 then
begin
Result := CallNextHookEx(hhk, nCode, wParam, lParam);
Exit;
end
else
begin
if BFirst then
// 侦测 Ctrl + B 组合键
//if ((lParam and _KeyPressMask) = 0) and (GetKeyState(vk_Control) < 0) and
// (wParam = VK_F2) then
//(GetKeyState(vk_Control) < 0) and (wParam = Ord('B')) then
begin
Result := 1;
ModMemData;
BFirst:=False;
//MessageBox(0, 'ok','',MB_OK);
// MessageBox(0, pchar(GetModuleName(GetModuleHandle(nil))),
// pchar(inttostr(GetCurrentThread)), 0);
end;
end;
end;
function SetKbHook(threadid: DWORD): boolean; stdcall; export; //外部调用
begin
if threadid <> 0 then
begin
hHk := SetWindowsHookEx(WH_GETMESSAGE, @keyHookProc, HInstance, threadid);
result := hhk <> 0;
end
else
begin
Result := UnHookWindowsHookEx(hHk);
end;
BFirst:=True;
end;
exports
SetKbHook;
end.
LineGame.pas
...{*******************************************************************************
Copyright (C), 2004, 风月工作室.
作者: 追风逐月
版本: 1.0
日期: 2005年12月28日
描述: QQ连连看游戏控制类
修改历史:
徐明 2005/12/28 1.0 创建该文件
...
********************************************************************************}
unit LineGame;
interface
uses
Windows,
Messages,
ShellAPI,
Classes;
const
MAP_HLENGTH = 19;
MAP_VLENGTH = 11;
MAPCOUNT = 100;
gLeft = 16;
gTop = 184;
hwidth = 31;
vWidth = 35;
type
TLineGame = class
private
Maps: array[0..MAP_VLENGTH - 1, 0..MAP_HLENGTH - 1] of integer;
gh: THandle;
RectA: TRect;
LineMap: TStringList;
ptLines: array[1..MAPCOUNT] of Tlist;
FGameThreadID:integer;
procedure SetPtLines;
function CanConnect(P1, P2: TPoint): boolean;
function CanLine(P1, P2: TPoint): Boolean;
function isEmptyPt(pt: TPoint): boolean;
function GetMapIndex(Color: integer): integer;
function LeftMapCount: integer;
procedure GetColor(x, y: Integer; var col: Cardinal);
function GetColorMx(i, j: integer): Cardinal;
function isBackGround(Color: Integer): boolean;
procedure SendMouse(x1, y1, x2, y2: Integer);
function GetMapPos(i, j: integer): Tpoint;
function Search(var P1, P2: TPoint): boolean;
function isSameMap(Color1, Color2: integer): boolean;
procedure GetBox;
procedure SetMemData(hnd:THandle);
public
constructor Create;
destructor Destroy; override;
procedure AutoStart;
procedure RunStep;
procedure KillAll;
end;
function SetKbHook(threadid:DWORD):bool;stdcall; external 'kbhook.dll' ;
implementation
function StrToInt(const S: string): Integer;
var
E: Integer;
begin
Val(S, Result, E);
//if E <> 0 then ConvertErrorFmt(@SInvalidInteger, [S]);
end;
...{ TLineGame }
...{*************************************************
函数名: TLineGame.GetColor
描 述: 获取指定位置（屏幕坐标）的颜色值
参 数: x, y: Integer; var col: Cardinal
返回值: None
*************************************************}
procedure TLineGame.GetColor(x, y: Integer; var col: Cardinal);
var
WindowDC: THandle;
begin
WindowDC := GetWindowDC(gh);
col := GetPixel(WindowDC, x, y);
ReleaseDC(gh, WindowDC);
end;
...{*************************************************
函数名: TLineGame.GetColorMx
描 述: 获取指定位置（对子矩阵坐标）的评估值
参 数: i, j: integer
返回值: Cardinal - 评估值
*************************************************}
function TLineGame.GetColorMx(i, j: integer): Cardinal;
var
x, y: integer;
col1, col2: Cardinal;
begin
x := gLeft + 14 + hwidth * i;
y := gTop + 18 + vwidth * j;
GetColor(x, y, col1);
x := x - 6;
GetColor(x, y, col2);
result := col1 + col2;
end;
...{*************************************************
函数名: TLineGame.Search
描 述: 搜索可以消除的对子的位置
参 数: var P1, P2: TPoint 可以消除的对子坐标
返回值: boolean
*************************************************}
function TLineGame.Search(var P1, P2: TPoint): boolean;
var
i, j, k: integer;
LineList: TList;
begin
result := false;
for i := Low(ptlines) to High(ptlines) do
begin
LineList := ptLines[i];
for j := 0 to LineList.Count - 1 do
for k := j + 1 to LineList.Count - 1 do
begin
p1 := pPoint(LineList.Items[j])^;
p2 := pPoint(LineList.Items[k])^;
if CanConnect(p1, p2) then
begin
result := true;
Dispose(LineList.Items[k]);
LineList.Delete(k);
Maps[p1.X, p1.Y] := -2;
Dispose(LineList.Items[j]);
LineList.Delete(j);
Maps[p2.X, p2.Y] := -2;
exit;
end;
end;
end;
end;
...{*************************************************
函数名: TLineGame.CanConnect
描 述: 判断两点是否连通
参 数: P1, P2: TPoint
返回值: boolean
*************************************************}
function TLineGame.CanConnect(P1, P2: TPoint): boolean;
var
mpt1, mpt2: TPoint;
begin
result := false;
if (p1.x = p2.X) and (p1.y = p2.Y) then
exit;
//可以直线相连
Result := Canline(P1, p2);
if result then
exit;
//一个拐点
mpt1.X := p1.X;
mpt1.Y := p2.Y;
Result := (isEmptyPt(mpt1)) and Canline(P1, mpt1) and Canline(mpt1, P2);
if result then
exit;
mpt1.X := p2.X;
mpt1.Y := p1.Y;
Result := (isEmptyPt(mpt1)) and Canline(P1, mpt1) and Canline(mpt1, P2);
if result then
exit;
//两个拐点
//以p1为基准
//获取y坐标方向的空点
mpt1.y := p1.Y;
mpt2.Y := p2.Y;
mpt1.X := p1.X - 1;
while (mpt1.x > -1) and (isEmptyPt(mpt1)) do
begin
mpt2.X := mpt1.X;
if isEmptyPt(mpt2) then
result := CanLine(mpt1, mpt2) and CanLine(mpt2, p2);
if result then
exit;
dec(mpt1.X);
end;
mpt1.X := p1.X + 1;
while (mpt1.x < MAP_VLENGTH) and (isEmptyPt(mpt1)) do
begin
mpt2.X := mpt1.X;
if isEmptyPt(mpt2) then
result := CanLine(mpt1, mpt2) and CanLine(mpt2, p2);
if result then
exit;
inc(mpt1.X);
end;
//获取x坐标方向的空点
mpt1.x := p1.x;
mpt2.x := p2.x;
mpt1.y := p1.y - 1;
while (mpt1.y > -1) and (isEmptyPt(mpt1)) do
begin
mpt2.y := mpt1.y;
if isEmptyPt(mpt2) then
result := CanLine(mpt1, mpt2) and CanLine(mpt2, p2);
if result then
exit;
dec(mpt1.y);
end;
mpt1.y := p1.y + 1;
while (mpt1.y < MAP_HLENGTH) and (isEmptyPt(mpt1)) do
begin
mpt2.y := mpt1.y;
if isEmptyPt(mpt2) then
result := CanLine(mpt1, mpt2) and CanLine(mpt2, p2);
if result then
exit;
inc(mpt1.y);
end;
end;
...{*************************************************
函数名: TLineGame.CanLine
描 述: 判断两点是否可以直线相连
参 数: P1, P2: TPoint
返回值: Boolean
*************************************************}
function TLineGame.CanLine(P1, P2: TPoint): Boolean;
var
i: integer;
begin
result := false;
// 横1....1
if (p1.y = p2.Y) then
begin
if p1.x > p2.X then
begin
result := CanLine(P2, P1);
end
else
begin
result := true;
for i := p1.X + 1 to p2.X - 1 do
begin
result := Maps[i, p1.Y] = -2;
if not result then
exit;
end;
end;
end
else if (p1.x = p2.x) then // 竖
begin
if p1.y > p2.y then
begin
result := CanLine(P2, P1);
end
else
begin
result := true;
for i := p1.y + 1 to p2.y - 1 do
begin
result := Maps[p1.x, i] = -2;
if not result then
exit;
end;
end;
end;
end;
...{*************************************************
函数名: TLineGame.isEmptyPt
描 述: 是否空白点
参 数: pt: TPoint
返回值: boolean
*************************************************}
function TLineGame.isEmptyPt(pt: TPoint): boolean;
begin
result := Maps[pt.X, pt.Y] = -2;
end;
...{*************************************************
函数名: TLineGame.Create
描 述: 创建TlineGame类
参 数: None
返回值: None
*************************************************}
constructor TLineGame.Create;
var
i: integer;
Res: TResourceStream;
begin
LineMap := TStringList.Create;
Res := TResourceStream.Create(HInstance,'SRC1', PChar('FILE1'));
LineMap.LoadFromStream(res);
Res.Free;
for i := 1 to MAPCOUNT do
begin
ptLines[i] := TList.Create;
end;
end;
...{*************************************************
函数名: TLineGame.Destroy
描 述: 消耗TLineGame类
参 数: None
返回值: None
*************************************************}
destructor TLineGame.Destroy;
var
i: integer;
begin
LineMap.Free;
for i := MAPCOUNT downto 1 do
begin
ptLines[i].Free;
end;
SetKbHook(0);
end;
...{*************************************************
函数名: TLineGame.SetPtLines
描 述: 根据矩阵设置对子队列
参 数: None
返回值: None
*************************************************}
procedure TLineGame.SetPtLines;
var
i, j: integer;
pt: pPoint;
mapValue: integer;
begin
try
for i := 1 to MAPCOUNT do
for j := ptLines[i].Count - 1 downto 0 do
begin
Dispose(ptLines[i].Items[j]);
ptLines[i].Delete(j);
end;
for i := 0 to MAP_VLENGTH - 1 do
for j := 0 to MAP_HLENGTH - 1 do
begin
new(pt);
pt.X := i;
pt.Y := j;
mapValue := Maps[i, j];
if mapValue <> -2 then
begin
ptLines[mapValue].Add(pt);
end;
end;
except
end;
end;
...{*************************************************
函数名: TLineGame.isSameMap
描 述: 判断两点是否相似，如相似则认为是同一类型的点
参 数: Color1, Color2: integer
返回值: boolean
*************************************************}
function TLineGame.isSameMap(Color1, Color2: integer): boolean;
var
r1, g1, b1: Integer;
r2, g2, b2: Integer;
begin
r1 := GetRValue(Color1);
g1 := GetGValue(Color1);
b1 := GetBValue(Color1);
r2 := GetRValue(Color2);
g2 := GetGValue(Color2);
b2 := GetBValue(Color2);
Result := (abs(r1 - r2) < 5) and (abs(g1 - g2) < 5) and (abs(b1 - b2) < 5)
end;
...{*************************************************
函数名: TLineGame.GetMapIndex
描 述: 根据颜色值，判断其所属的类型队列的位置
参 数: Color: integer
返回值: integer
*************************************************}
function TLineGame.GetMapIndex(Color: integer): integer;
var
i: integer;
Color1: integer;
begin
result := -2;
for i := 0 to LineMap.Count - 1 do
begin
Color1 := StrToInt(LineMap.Names[i]);
if isSameMap(Color, Color1) then
begin
result := strtoint(LineMap.ValueFromIndex[i]);
exit;
end;
end;
end;
...{*************************************************
函数名: TLineGame.LeftMapCount
描 述: 计算ptLine中剩余的点数
参 数: None
返回值: integer
*************************************************}
function TLineGame.LeftMapCount: integer;
var
i: integer;
begin
Result := 0;
for i := 1 to MAPCOUNT do
begin
inc(Result, ptLines[i].Count);
end;
end;
...{*************************************************
函数名: TLineGame.GetBox
描 述: 获取游戏界面布局数据
参 数: None
返回值: None
*************************************************}
procedure TLineGame.GetBox;
var
i, j: Integer;
color1: Cardinal;
begin
gh := FindWindow(nil, PChar('QQ连连看'));
//生成数组
GetWindowRect(gh, Recta);
for i := 0 to MAP_VLENGTH - 1 do
for j := 0 to MAP_HLENGTH - 1 do
begin
color1 := GetColorMx(j, i);
if isBackGround(color1) then
maps[i, j] := -2
else
maps[i, j] := GetMapIndex(color1);
end;
end;
...{*************************************************
函数名: TLineGame.isBackGround
描 述: 判断是否游戏中的背景
参 数: Color: Integer
返回值: boolean
*************************************************}
function TLineGame.isBackGround(Color: Integer): boolean;
var
r, g, b: Integer;
begin
r := GetRValue(Color);
g := GetGValue(Color);
b := GetBValue(Color);
Result := (Abs(110 - r) < 20) and (abs(154 - g) < 20) and (abs(236 - b) < 20);
end;
...{*************************************************
函数名: TLineGame.GetMapPos
描 述: 获取对子矩阵中点在游戏中的位置
参 数: i, j: integer
返回值: Tpoint
*************************************************}
function TLineGame.GetMapPos(i, j: integer): Tpoint;
begin
result.x := Recta.Left + gLeft + 16 + hwidth * j;
result.y := recta.Top + gTop + 18 + vwidth * i;
end;
...{*************************************************
函数名: TLineGame.SendMouse
描 述: 模拟发送消除对子的消息
参 数: x1, y1, x2, y2: Integer
返回值: None
*************************************************}
procedure TLineGame.SendMouse(x1, y1, x2, y2: Integer);
var
pos1, pos2: TPoint;
Recta: TRect;
begin
GetWindowRect(gh, Recta);
pos1 := GetMapPos(x1, y1);
PostMessage(gh, WM_LBUTTONDOWN, 0, MakeLong(pos1.X - Recta.Left, pos1.y -
Recta.Top));
Pos2 := GetMapPos(x2, y2);
PostMessage(gh, WM_LBUTTONDOWN, 0, MakeLong(pos2.X - Recta.Left, pos2.y -
Recta.Top));
end;
...{*************************************************
函数名: TLineGame.RunStep
描 述: 消除一组对子
参 数:
返回值: None
*************************************************}
procedure TLineGame.RunStep();
var
p1, p2: TPoint;
begin
gh := FindWindow(nil, PChar('QQ连连看'));
SetMemData(gh);
GetBox;
SetPtLines;
if Search(p1, p2) then
begin
SendMouse(p1.X, p1.Y, p2.X, p2.Y);
end;
end;
...{*************************************************
函数名: TLineGame.KillAll
描 述: 消除所有对子
参 数:
返回值: None
*************************************************}
procedure TLineGame.KillAll();
var
p1, p2: TPoint;
SearchFail: Boolean;
begin
gh := FindWindow(nil, PChar('QQ连连看'));
SetMemData(gh);
GetBox;
SetPtLines;
repeat
SearchFail := true;
while Search(p1, p2) do
begin
SearchFail := False;
SendMouse(p1.X, p1.Y, p2.X, p2.Y);
end;
until (LeftMapCount = 0) or SearchFail;
end;
...{*************************************************
函数名: TLineGame.AutoStart
描 述: 自动开始游戏
参 数: None
返回值: None
*************************************************}
procedure TLineGame.AutoStart;
begin
gh := FindWindow(nil, PChar('QQ连连看'));
PostMessage(gh, WM_LBUTTONDOWN, 0, MakeLong(684, 532));
PostMessage(gh, WM_LBUTTONUP, 0, MakeLong(684, 532));
end;
procedure TLineGame.SetMemData(hnd: THandle);
var ThreadProcessID:integer;
begin
ThreadProcessID:=GetWindowThreadProcessId(hnd,nil);
if ThreadProcessID=FGameThreadID then exit;
FGameThreadID:=ThreadProcessID ;
SetKbHook(FGameThreadID);
end;
end.
QQLLK.dpr
...{*************************************************
Copyright (C), 2004, 风月工作室.
作者: 追风逐月
版本: 1.0
日期: 2005年02月01日
描述:
修改历史:
徐明 2005/02/01 1.0 创建该文件
...
*************************************************}
...{$J+}
program QQLLK;
uses
Windows,
Messages,
SysUtils,
ShellAPI,
LineGame in 'LineGame.pas';
...{$R qqllk.res}
const
////////////////
//资源常量定义// ;不要修改！
////////////////
MAINICON = 'MAINICON';
IDD_MAINDLG = 1000;
MAIN_SINGLE = 1002;
MAIN_ALL = 1003;
MAIN_OPTION = 1006;
MAIN_ABOUT = 1001;
MAIN_EXIT = 1004;
IDD_ABOUTDLG = 3000;
ABOUT_OK = 3001;
ABOUT_CLOSE = 3002;
ABOUT_FILE = 3003;
ABOUT_AUTHOR = 3004;
ABOUT_MEMO = 3005;
IDD_OPTIONDLG = 2000;
OPTION_OK = 2001;
OPTION_CANCEL = 2002;
OPTION_ABOUT = 2003;
OPTION_CLOSE = 2004;
OPTION_AUTOSTART = 1000;
OPTION_AUTOTOOLS = 1001;
OPTION_RANDOM = 1006;
OPTION_COMPUTER = 1007;
OPTION_TIMER = 1008;
const
////////////////
//常量数据声明//
////////////////
(*颜色设定*)
//clBackground = $8B190B; //背景颜色
clBackground = $87D34; //背景颜色
clText = $E4E4E4; //文字颜色
//clFrom = $871200; //标题栏渐变起始颜色
//clTo = $808080; //标题栏渐变结束颜色
clFrom = $87D34; //标题栏渐变起始颜色
clTo = $808080; //标题栏渐变结束颜色
ID_HOTKEYF2 = 200; //热键F2
ID_HOTKEYF3 = 300; //热键F3
ID_HOTKEYCTRLF4 = 400; //热键CTRL+F4
szMainCaption = 'QQ连连看外挂';
...{*选项对话框*}
szOptionCaption = '选项'; //关于对话框标题
(*关于对话框*)
szAboutCaption = '关于 QQ连连看外挂'; //关于对话框标题
szFile = '版本 1.1.0.0'; //注册机说明
szAuthor = '『由[追风逐月]编写』'; //注册机作者
szGreet = //字幕内容每行不要超过32个字符(16个汉字)
'本软件由风月工作室出品'#10#10 + '〖联系方式〗'#10#10'coolchyni@gmail.com'#10#10+
'〖快捷键〗'#10#10+'F2:消除一组对子'#10'F3:消除所有对子'#10'CTRL+F4:显示/隐藏窗口'#10#10+
'〖特别感谢〗'#10#10+
'各位QQ游戏爱好者'#10'我的哥们'#10'以及所有曾帮助过我的人'#10#10 +
'〖免责声明〗'#10#10'本软件属于免费软件'#10'可以自由使用'#10'由此造成的一切后果（如QQ号被封）'#10'均与作者无关'#10#10 +
'〖版本信息〗'#10#10'[1.0.0.0]'#10'实现外挂程序基本功能'#10'[1.1.0.0]'#10'使用内存补丁的方法，'#10'去掉了原程序包中的连连看替换文件.'#10' ' ;
var
BKC: HBRUSH; //背景画刷
//h_Cur: HCURSOR; //鼠标指针句柄
h_Inst: HINST; //程序图标句柄
h_Icon: HICON; //实例句柄
h_mainDlg: HWND;
g_AutoStart: boolean = false; //自动开始
g_AutoTools: boolean = false; //自动使用工具
g_Random: boolean = false; //隐藏窗口
g_Computer: boolean = false; //电脑托管
g_timer: array[0..254] of char = '1000'; //消除频率
g_internal:integer=1000; //定时间隔
LineGames: TLineGame; //游戏类
function LinesInStr(srcStr: string): smallint;
var
i: integer;
begin
Result := 1;
for i := 0 to Length(srcStr) - 1 do
if srcStr[i] = #10 then
Result := Result + 1;
if Result > 1 then
Result := Result - 1;
end;
//////////////////////////////////////////////////////////////////
//动态显示窗体函数
procedure AnimateShow(hDlg: HWND);
var
Rt: TRECT;
x, y, i: smallint;
h_Rgn: HRGN;
begin
ShowWindow(hDlg, SW_HIDE);
GetWindowRect(hDlg, Rt);
x := (Rt.right - Rt.left) div 2;
y := (Rt.bottom - Rt.top) div 2;
for i := 0 to (Rt.Right div 2) do
begin
h_Rgn := CreateRectRgn(x - i, y - i, x + i, y + i);
SetWindowRgn(hDlg, h_Rgn, True);
ShowWindow(hDlg, SW_SHOW);
DeleteObject(h_Rgn);
end;
SetWindowPos(hDlg, HWND_TOPMOST, rt.Left, rt.Top, rt.Right - rt.Left, rt.Bottom
- rt.Top, 0);
end;
//////////////////////////////////////////////////////////////
//绘制标题栏函数
//hDC: 绘制窗体的设备环境句柄
//hIco: 标题栏图标句柄
//szCaption: 标题栏标题
//rect: 标题栏矩形区域
//clBegin: 标题栏渐变起始颜色
//clEnd: 标题栏渐变结束颜色
procedure PaintCaption(h_DC: HDC; h_Ico: HICON; const szCaption: string; rect:
TRECT;
clBegin: COLORREF; clEnd: COLORREF);
var
brush: HBRUSH;
_logbrush: LOGBRUSH; //上色画刷
colorrect: TRECT; //上色矩形区域
h_font: HFONT; //标题栏字体
Haf, i: smallint;
R, G, B, fr, fg, fb, dr, dg, db: smallint;
begin
fr := GetRValue(clFrom); //分解颜色
fg := GetGValue(clFrom);
fb := GetBValue(clFrom);
dr := GetRValue(clTo);
dg := GetGValue(clTo);
db := GetBValue(clTo);
Haf := (rect.right - rect.left) div 2; //计算标题栏矩形区域中心
//设定上色矩形区域高度
colorrect.top := 0;
colorrect.bottom := rect.bottom - rect.top;
//建立渐变上色画刷
_logbrush.lbStyle := BS_SOLID;
_logbrush.lbHatch := 0;
for i := 0 to Haf do
begin
//设定左半上色矩形区域一次填充位置
colorrect.left := MulDiv(i, Haf, Haf);
colorrect.right := MulDiv(i + 1, Haf, Haf);
//颜色渐变
R := fr + MulDiv(i, dr, Haf);
G := fg + MulDiv(i, dg, Haf);
B := fb + MulDiv(i, db, Haf);
if (R > 255) then
R := 255;
if (G > 255) then
G := 255;
if (B > 255) then
B := 255;
_logbrush.lbColor := RGB(R, G, B);
brush := CreateBrushIndirect(_logbrush);
FillRect(h_DC, colorrect, brush); //填充左半区域
//设定右半上色矩形区域一次填充位置
colorrect.left := (rect.right - rect.left) - (MulDiv(i, Haf, Haf));
colorrect.right := (rect.right - rect.left) - (MulDiv(i + 1, Haf, Haf));
FillRect(h_DC, colorrect, brush); //填充右半区域
DeleteObject(brush);
end;
_logbrush.lbColor := $9E6A54;
brush := CreateBrushIndirect(_logbrush);
FrameRect(h_DC, rect, brush); //绘制标题栏边框
DeleteObject(brush);
SetTextColor(h_DC, $FFFFFF);
SetBkMode(h_DC, TRANSPARENT); //设定标题栏字体属性
rect.left := 2;
rect.top := 2;
rect.bottom := rect.Bottom - 2;
h_font := CreateFont(-12, 0, 0, 0, 700, 0, 0, 0, DEFAULT_CHARSET,
OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY,
DEFAULT_PITCH or FF_DONTCARE, '宋体');
//(宋体9号粗体字)
SelectObject(h_DC, h_font);
if h_Ico <> 0 then //若有图标则会制图标
begin
DrawIconEx(h_DC, 2, 2, h_Ico, 16, 16, 0, 0, DI_NORMAL);
rect.left := 20;
end;
//绘制标题栏标题
DrawText(h_DC, PChar(szCaption), -1, rect, DT_SINGLELINE or DT_VCENTER);
DeleteObject(h_font);
end;
//////////////////////////////////////////////////////////////
//绘制按钮函数
//pdis: 绘制内容结构指针
procedure DrawButton(pdis: PDRAWITEMSTRUCT);
var
szText: array[0..9] of char; //按钮文字
begin
FillRect(pdis.hDC, pdis.rcItem, BKC); //以背景色填充按钮
SetTextColor(pdis.hDC, clText);
SetBkMode(pdis.hDC, TRANSPARENT);
//尚未点击，绘制按钮边框-突起状态
DrawEdge(pdis.hDC, pdis.rcItem, BDR_RAISEDOUTER, BF_RECT);
GetWindowText(pdis.hwndItem, szText, sizeof(szText));
DrawText(pdis.hDC, szText, -1, pdis.rcItem, DT_SINGLELINE or DT_CENTER or
DT_VCENTER);
//已被按下，绘制按钮边框-凹陷状态
//if (pdis.itemState and ODS_SELECTED)=ODS_SELECTED then
if (pdis.itemState and ODS_SELECTED) <> 0 then
begin
SetTextColor(pdis.hDC, $00DDFF);
DrawText(pdis.hDC, szText, -1, pdis.rcItem, DT_SINGLELINE or DT_CENTER or
DT_VCENTER);
DrawEdge(pdis.hDC, pdis.rcItem, BDR_SUNKENOUTER, BF_RECT);
end;
end;
function ScrollProc(h_Wnd: HWND; Msg, wParam, lParam: DWORD): LRESULT; stdcall;
var
h_DC: HDC;
ps: TPAINTSTRUCT;
rc: TRECT;
h_font: HFONT;
begin
case Msg of
WM_PAINT:
begin
//绘制字幕内容
h_DC := BeginPaint(h_Wnd, ps);
GetClientRect(h_Wnd, rc);
SetTextColor(h_DC, clText);
SetBkMode(h_DC, TRANSPARENT);
h_font := CreateFont(-12, 0, 0, 0, 0, 0, 0, 0, DEFAULT_CHARSET,
OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH
or FF_DONTCARE, '宋体');
SelectObject(h_DC, h_font);
DrawText(h_DC, szGreet, -1, rc, DT_CENTER);
EndPaint(h_Wnd, ps);
DeleteObject(h_font);
end;
else
begin
//l:=GetWindowLong(h_Wnd,GWL_USERDATA);
//CallWindowProc(@l,h_Wnd,Msg,wParam,lParam);
end;
end;
result := 1;
end;
function AboutProc(hDlg: HWND; Msg, wParam, lParam: DWORD): LRESULT; stdcall;
const
rcCaption: TRECT = ();
i: smallint = 0;
w: smallint = 0;
h: smallint = 0;
h_Memo: HWND = 0;
memo: HWND = 0;
lines: smallint = 1; //字幕行数
var
h_dc: HDC;
ps: TPAINTSTRUCT;
pdis: PDRAWITEMSTRUCT;
pt: TPOINT;
rcMemo: TRECT;
lUser: integer;
h_Font: HFONT;
h_File: HWND;
begin
case Msg of
WM_INITDIALOG:
begin
GetClientRect(hDlg, rcCaption);
rcCaption.bottom := rcCaption.top + 20;
h_Memo := GetDlgItem(hDlg, ABOUT_MEMO);
h_File := GetDlgItem(hDlg, ABOUT_FILE);
h_Font := CreateFont(-12, 0, 0, 0, 700, 0, 0, 0, DEFAULT_CHARSET,
OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH
or FF_DONTCARE, '宋体');
SendMessage(h_File, WM_SETFONT, h_Font, 0);
SetDlgItemText(hDlg, ABOUT_FILE, szFile);
SetDlgItemText(hDlg, ABOUT_AUTHOR, szAuthor);
SetWindowText(hDlg, szAboutCaption);
GetClientRect(h_Memo, rcMemo); //得到字幕显示区域大小
w := rcMemo.right - rcMemo.left;
h := rcMemo.bottom - rcMemo.top;
i := h;
lines := LinesInStr(szGreet); //计算字幕行数
//建立显示字幕子窗体
memo := CreateWindow('Static', '', WS_VISIBLE or WS_CHILD or SS_CENTER,
0, h, w, 12 * lines, h_Memo, 0, h_Inst, nil);
//设定子窗体消息处理函数
lUser := SetWindowLong(memo, GWL_WNDPROC, integer(@ScrollProc));
SetWindowLong(memo, GWL_USERDATA, lUser);
AnimateShow(hDlg);
SetTimer(hDlg, 168, 80, nil); //设定定时器每80毫秒触发一次
result := 1;
end;
WM_TIMER:
begin
//定时器触发时移动子窗体，形成字幕
Sleep(20);
i := i - 1;
SetWindowPos(memo, 0, 0, i, w, 12 * lines, 0);
if (-(i + (12 * lines)) > 0) then
i := h; //字幕到达尾部时，重新开始循环
end;
WM_LBUTTONDOWN:
begin
pt.x := LOWORD(lParam);
pt.y := HIWORD(lParam);
if (PtInRect(rcCaption, pt)) then
PostMessage(hDlg, WM_NCLBUTTONDOWN, HTCAPTION, 0);
end;
WM_PAINT:
begin
h_dc := BeginPaint(hDlg, ps);
PaintCaption(h_dc, h_Icon, szAboutCaption, rcCaption, clFrom, clTo);
EndPaint(hDlg, ps);
end;
WM_COMMAND:
begin
case wParam of
ABOUT_OK:
begin
KillTimer(hDlg, 168); //销毁定时器
EndDialog(hDlg, 0);
end;
ABOUT_CLOSE:
begin
KillTimer(hDlg, 168); //销毁定时器
EndDialog(hDlg, 0);
end;
end;
result := 0;
end;
WM_DRAWITEM:
begin
pdis := PDRAWITEMSTRUCT(lParam);
DrawButton(pdis);
Result := 0;
end;
///////////////////////////////////////////////////
//响应绘制窗体内容消息
WM_CTLCOLORDLG:
begin
SetTextColor(wParam, clText);
SetBkMode(wParam, TRANSPARENT);
Result := BKC;
end;
WM_CTLCOLORSTATIC:
begin
SetTextColor(wParam, clText);
SetBkMode(wParam, TRANSPARENT);
Result := BKC;
end;
else
Result := 0;
end;
end;
function OptionProc(hDlg: HWND; Msg, wParam, lParam: DWORD): LRESULT; stdcall;
const
rcCaption: TRECT = ();
i: smallint = 0;
w: smallint = 0;
h: smallint = 0;
h_Memo: HWND = 0;
memo: HWND = 0;
lines: smallint = 1; //字幕行数
var
h_dc: HDC;
ps: TPAINTSTRUCT;
pdis: PDRAWITEMSTRUCT;
pt: TPOINT;
h_Font: HFONT;
h_File: HWND;
e: integer;
begin
case Msg of
WM_INITDIALOG:
begin
GetClientRect(hDlg, rcCaption);
rcCaption.bottom := rcCaption.top + 20;
h_Memo := GetDlgItem(hDlg, ABOUT_MEMO);
h_File := GetDlgItem(hDlg, ABOUT_FILE);
h_Font := CreateFont(-12, 0, 0, 0, 700, 0, 0, 0, DEFAULT_CHARSET,
OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH
or FF_DONTCARE, '宋体');
SendMessage(h_File, WM_SETFONT, h_Font, 0);
CheckDlgButton(hdlg, OPTION_AUTOSTART, ord(g_AutoStart));
CheckDlgButton(hdlg, OPTION_AUTOTOOLS, ord(g_AutoTools));
CheckDlgButton(hdlg, OPTION_RANDOM, ord(g_Random));
CheckDlgButton(hdlg, OPTION_COMPUTER, ord(g_Computer));
SetDlgItemText(hDlg, OPTION_TIMER, g_timer);
result := 1;
end;
WM_LBUTTONDOWN:
begin
pt.x := LOWORD(lParam);
pt.y := HIWORD(lParam);
if (PtInRect(rcCaption, pt)) then
PostMessage(hDlg, WM_NCLBUTTONDOWN, HTCAPTION, 0);
end;
WM_PAINT:
begin
h_dc := BeginPaint(hDlg, ps);
PaintCaption(h_dc, h_Icon, szOptionCaption, rcCaption, clFrom, clTo);
EndPaint(hDlg, ps);
end;
WM_COMMAND:
begin
case wParam of
OPTION_OK:
begin
g_AutoStart := IsDlgButtonChecked(hDlg, OPTION_AUTOSTART) =
BST_CHECKED;
g_AutoTools := IsDlgButtonChecked(hDlg, OPTION_AUTOTOOLS) =
BST_CHECKED;
g_Random := IsDlgButtonChecked(hDlg, OPTION_RANDOM) =
BST_CHECKED;
g_Computer := IsDlgButtonChecked(hDlg, OPTION_COMPUTER) =
BST_CHECKED;
GetDlgItemText(hDlg, OPTION_TIMER, g_timer, 255);
//LineGames.AutoStart;
Val(g_timer, g_internal, E);
if (E <> 0) or (g_internal < 500) or (g_internal > 10000) then
begin
g_internal := 1000;
MessageBox(hDlg, pchar('请输入一个有效的整数（500~10000）!'),
pchar('输入错误'),
MB_ICONERROR);
exit;
end;
if g_autostart or g_Computer then
SetTimer(h_mainDlg, 169, g_internal, nil)
else
KillTimer(h_mainDlg, 169);
//设定定时器每1000毫秒触发一次
EndDialog(hDlg, 0);
end;
OPTION_ABOUT: DialogBox(h_Inst, LPCTSTR(IDD_ABOUTDLG), hDlg,
@AboutProc);
OPTION_CANCEL, OPTION_CLOSE:
begin
EndDialog(hDlg, 0);
end;
end;
result := 0;
end;
WM_DRAWITEM:
begin
pdis := PDRAWITEMSTRUCT(lParam);
DrawButton(pdis);
Result := 0;
end;
///////////////////////////////////////////////////
//响应绘制窗体内容消息
WM_CTLCOLORDLG:
begin
SetTextColor(wParam, clText);
SetBkMode(wParam, TRANSPARENT);
Result := BKC;
end;
WM_CTLCOLORSTATIC:
begin
SetTextColor(wParam, clText);
SetBkMode(wParam, TRANSPARENT);
Result := BKC;
end;
else
Result := 0;
end;
end;
function MainProc(hDlg: HWND; Msg, wParam, lParam: DWORD): LRESULT; stdcall;
const
rcCaption: TRECT = ();
var
h_dc: HDC;
ps: TPAINTSTRUCT;
pdis: PDRAWITEMSTRUCT;
pt: TPOINT;
begin
case Msg of
WM_INITDIALOG:
begin
h_mainDlg := hDlg;
GetClientRect(hDlg, rcCaption);
rcCaption.bottom := rcCaption.top + 20;
SetWindowText(hDlg, szMainCaption);
AnimateShow(hDlg);
if (RegisterHotKey(hDlg, ID_HOTKEYF2, 0, VK_F2) = false) then
begin
//hotkey注册
//失败了的话...
MessageBox(hDlg, pchar('注册热键F2失败!'), pchar('Error'),
MB_ICONERROR);
PostQuitMessage(0);
end;
if (RegisterHotKey(hDlg, ID_HOTKEYF3, 0, VK_F3) = false) then
begin
//hotkey注册
//失败了的话...
MessageBox(hDlg, pchar('注册热键F3失败!'), pchar('Error'),
MB_ICONERROR);
PostQuitMessage(0);
end;
if (RegisterHotKey(hDlg, ID_HOTKEYCTRLF4, MOD_CONTROL, VK_F4) = false)
then
begin
//hotkey注册
//失败了的话...
MessageBox(hDlg, pchar('注册热键CTRL+F4失败!'), pchar('Error'),
MB_ICONERROR);
PostQuitMessage(0);
end;
result := 1;
end;
WM_HOTKEY: //处理WM_HOTKEY消息
begin
case HIWORD(lParam) of
VK_F3: LineGames.KillAll;
vk_F2: LineGames.RunStep;
VK_F4:
begin
if IsWindowVisible(hDlg) then
showWindow(hDlg, SW_HIDE)
else
showWindow(hDlg, SW_SHOW);
end;
end;
result := 0;
end;
WM_LBUTTONDOWN:
begin
//响应鼠标左键按下消息，若在标题栏内则使窗体移动
pt.x := LOWORD(lParam);
pt.y := HIWORD(lParam);
if PtInRect(rcCaption, pt) then
PostMessage(hDlg, WM_NCLBUTTONDOWN, HTCAPTION, 0);
end;
WM_PAINT:
begin
//响应绘制消息，绘制标题栏
h_DC := BeginPaint(hDlg, ps);
PaintCaption(h_DC, h_Icon, szMainCaption, rcCaption, clFrom, clTo);
EndPaint(hDlg, ps);
end;
WM_COMMAND:
begin
case wParam of
MAIN_SINGLE:
begin
LineGames.RunStep;
end;
MAIN_ALL: LineGames.KillAll();
MAIN_OPTION: DialogBox(h_Inst, LPCTSTR(IDD_OPTIONDLG), hDlg,
@OptionProc);
MAIN_ABOUT:
DialogBox(h_Inst, LPCTSTR(IDD_ABOUTDLG), hDlg, @AboutProc);
MAIN_EXIT: EndDialog(hDlg, 0);
end;
result := 0;
end;
WM_DRAWITEM:
begin
pdis := PDRAWITEMSTRUCT(lParam);
DrawButton(pdis);
Result := 0;
end;
WM_TIMER:
begin
//定时器触发时移动子窗体，形成字幕
if g_AutoStart then
LineGames.AutoStart;
if g_Computer then
LineGames.RunStep;
if g_Random then
SetTimer(hDlg,169,500+Random(g_internal-500),nil);
end;
///////////////////////////////////////////////////
//响应绘制窗体内容消息
WM_CTLCOLORDLG:
begin
SetTextColor(wParam, clText);
SetBkMode(wParam, TRANSPARENT);
Result := BKC;
end;
WM_CTLCOLORSTATIC:
begin
SetTextColor(wParam, clText);
SetBkMode(wParam, TRANSPARENT);
Result := BKC;
end;
WM_DESTROY:
begin
UnregisterHotKey(hDlg, ID_HOTKEYF2); //用完记得要收回
UnregisterHotKey(hDlg, ID_HOTKEYF3); //用完记得要收回
UnregisterHotKey(hDlg, ID_HOTKEYCTRLF4); //用完记得要收回
KillTimer(hDlg, 169);
PostQuitMessage(0);
end;
else
Result := 0;
end;
end;
//////////////////////////////////////////////////////////////////
//程序入口函数
//
begin
h_Inst := GetModuleHandle(nil); //保存实例句柄
BKC := CreateSolidBrush(clBackground); //建立背景画刷
//h_Cur := LoadCursor(h_Inst, LPCTSTR(IDC_HAND)); //载入鼠标指针
h_Icon := LoadIcon(h_Inst, LPCTSTR(MAINICON)); //载入程序图标
//显示协议对话框
LineGames := TLineGame.Create;
DialogBox(h_Inst, LPCTSTR(IDD_MAINDLG), 0, @MainProc);
LineGames.Free;
DeleteObject(BKC); //释放背景画刷
//退出程序
ExitProcess(0);
end.
library kbhook;
{ Important note about DLL memory management: ShareMem must be the
first unit in your library's USES clause AND your project's (select
Project-View Source) USES clause if your DLL exports any procedures or
functions that pass strings as parameters or function results. This
applies to all strings passed to and from your DLL--even those that
are nested in records and classes. ShareMem is the interface unit to
the BORLNDMM.DLL shared memory manager, which must be deployed along
with your DLL. To avoid using BORLNDMM.DLL, pass string information
using PChar or ShortString parameters. }
uses
windows;
var
hHk: HHOOK;
BFirst:Boolean=True;
//{$R *.res}
procedure ModMemData();
var
pData: pointer;
dwOldProtect: DWORD;
mbi_thunk: TMemoryBasicInformation;
begin
pData := pointer($00403296);
//查询页信息。
VirtualQuery(pData, mbi_thunk, sizeof(MEMORY_BASIC_INFORMATION));
//改变页保护属性为读写。
VirtualProtect(mbi_thunk.BaseAddress, mbi_thunk.RegionSize,
PAGE_READWRITE, mbi_thunk.Protect);
//清零。
PByte(pData)^ := 0;
//恢复页的原保护属性。
VirtualProtect(mbi_thunk.BaseAddress, mbi_thunk.RegionSize,
mbi_thunk.Protect, dwOldProtect);
end;
function keyHookProc(nCode: Integer; WParam: WPARAM; LParam: LPARAM): LRESULT;
stdcall;
const
_KeyPressMask = $80000000;
begin
Result := 0;
if nCode < 0 then
begin
Result := CallNextHookEx(hhk, nCode, wParam, lParam);
Exit;
end
else
begin
if BFirst then
// 侦测 Ctrl + B 组合键
//if ((lParam and _KeyPressMask) = 0) and (GetKeyState(vk_Control) < 0) and
// (wParam = VK_F2) then
//(GetKeyState(vk_Control) < 0) and (wParam = Ord('B')) then
begin
Result := 1;
ModMemData;
BFirst:=False;
//MessageBox(0, 'ok','',MB_OK);
// MessageBox(0, pchar(GetModuleName(GetModuleHandle(nil))),
// pchar(inttostr(GetCurrentThread)), 0);
end;
end;
end;
function SetKbHook(threadid: DWORD): boolean; stdcall; export; //外部调用
begin
if threadid <> 0 then
begin
hHk := SetWindowsHookEx(WH_GETMESSAGE, @keyHookProc, HInstance, threadid);
result := hhk <> 0;
end
else
begin
Result := UnHookWindowsHookEx(hHk);
end;
BFirst:=True;
end;
exports
SetKbHook;
end.
LineGame.pas
...{*******************************************************************************
Copyright (C), 2004, 风月工作室.
作者: 追风逐月
版本: 1.0
日期: 2005年12月28日
描述: QQ连连看游戏控制类
修改历史:
徐明 2005/12/28 1.0 创建该文件
...
********************************************************************************}
unit LineGame;
interface
uses
Windows,
Messages,
ShellAPI,
Classes;
const
MAP_HLENGTH = 19;
MAP_VLENGTH = 11;
MAPCOUNT = 100;
gLeft = 16;
gTop = 184;
hwidth = 31;
vWidth = 35;
type
TLineGame = class
private
Maps: array[0..MAP_VLENGTH - 1, 0..MAP_HLENGTH - 1] of integer;
gh: THandle;
RectA: TRect;
LineMap: TStringList;
ptLines: array[1..MAPCOUNT] of Tlist;
FGameThreadID:integer;
procedure SetPtLines;
function CanConnect(P1, P2: TPoint): boolean;
function CanLine(P1, P2: TPoint): Boolean;
function isEmptyPt(pt: TPoint): boolean;
function GetMapIndex(Color: integer): integer;
function LeftMapCount: integer;
procedure GetColor(x, y: Integer; var col: Cardinal);
function GetColorMx(i, j: integer): Cardinal;
function isBackGround(Color: Integer): boolean;
procedure SendMouse(x1, y1, x2, y2: Integer);
function GetMapPos(i, j: integer): Tpoint;
function Search(var P1, P2: TPoint): boolean;
function isSameMap(Color1, Color2: integer): boolean;
procedure GetBox;
procedure SetMemData(hnd:THandle);
public
constructor Create;
destructor Destroy; override;
procedure AutoStart;
procedure RunStep;
procedure KillAll;
end;
function SetKbHook(threadid:DWORD):bool;stdcall; external 'kbhook.dll' ;
implementation
function StrToInt(const S: string): Integer;
var
E: Integer;
begin
Val(S, Result, E);
//if E <> 0 then ConvertErrorFmt(@SInvalidInteger, [S]);
end;
...{ TLineGame }
...{*************************************************
函数名: TLineGame.GetColor
描 述: 获取指定位置（屏幕坐标）的颜色值
参 数: x, y: Integer; var col: Cardinal
返回值: None
*************************************************}
procedure TLineGame.GetColor(x, y: Integer; var col: Cardinal);
var
WindowDC: THandle;
begin
WindowDC := GetWindowDC(gh);
col := GetPixel(WindowDC, x, y);
ReleaseDC(gh, WindowDC);
end;
...{*************************************************
函数名: TLineGame.GetColorMx
描 述: 获取指定位置（对子矩阵坐标）的评估值
参 数: i, j: integer
返回值: Cardinal - 评估值
*************************************************}
function TLineGame.GetColorMx(i, j: integer): Cardinal;
var
x, y: integer;
col1, col2: Cardinal;
begin
x := gLeft + 14 + hwidth * i;
y := gTop + 18 + vwidth * j;
GetColor(x, y, col1);
x := x - 6;
GetColor(x, y, col2);
result := col1 + col2;
end;
...{*************************************************
函数名: TLineGame.Search
描 述: 搜索可以消除的对子的位置
参 数: var P1, P2: TPoint 可以消除的对子坐标
返回值: boolean
*************************************************}
function TLineGame.Search(var P1, P2: TPoint): boolean;
var
i, j, k: integer;
LineList: TList;
begin
result := false;
for i := Low(ptlines) to High(ptlines) do
begin
LineList := ptLines[i];
for j := 0 to LineList.Count - 1 do
for k := j + 1 to LineList.Count - 1 do
begin
p1 := pPoint(LineList.Items[j])^;
p2 := pPoint(LineList.Items[k])^;
if CanConnect(p1, p2) then
begin
result := true;
Dispose(LineList.Items[k]);
LineList.Delete(k);
Maps[p1.X, p1.Y] := -2;
Dispose(LineList.Items[j]);
LineList.Delete(j);
Maps[p2.X, p2.Y] := -2;
exit;
end;
end;
end;
end;
...{*************************************************
函数名: TLineGame.CanConnect
描 述: 判断两点是否连通
参 数: P1, P2: TPoint
返回值: boolean
*************************************************}
function TLineGame.CanConnect(P1, P2: TPoint): boolean;
var
mpt1, mpt2: TPoint;
begin
result := false;
if (p1.x = p2.X) and (p1.y = p2.Y) then
exit;
//可以直线相连
Result := Canline(P1, p2);
if result then
exit;
//一个拐点
mpt1.X := p1.X;
mpt1.Y := p2.Y;
Result := (isEmptyPt(mpt1)) and Canline(P1, mpt1) and Canline(mpt1, P2);
if result then
exit;
mpt1.X := p2.X;
mpt1.Y := p1.Y;
Result := (isEmptyPt(mpt1)) and Canline(P1, mpt1) and Canline(mpt1, P2);
if result then
exit;
//两个拐点
//以p1为基准
//获取y坐标方向的空点
mpt1.y := p1.Y;
mpt2.Y := p2.Y;
mpt1.X := p1.X - 1;
while (mpt1.x > -1) and (isEmptyPt(mpt1)) do
begin
mpt2.X := mpt1.X;
if isEmptyPt(mpt2) then
result := CanLine(mpt1, mpt2) and CanLine(mpt2, p2);
if result then
exit;
dec(mpt1.X);
end;
mpt1.X := p1.X + 1;
while (mpt1.x < MAP_VLENGTH) and (isEmptyPt(mpt1)) do
begin
mpt2.X := mpt1.X;
if isEmptyPt(mpt2) then
result := CanLine(mpt1, mpt2) and CanLine(mpt2, p2);
if result then
exit;
inc(mpt1.X);
end;
//获取x坐标方向的空点
mpt1.x := p1.x;
mpt2.x := p2.x;
mpt1.y := p1.y - 1;
while (mpt1.y > -1) and (isEmptyPt(mpt1)) do
begin
mpt2.y := mpt1.y;
if isEmptyPt(mpt2) then
result := CanLine(mpt1, mpt2) and CanLine(mpt2, p2);
if result then
exit;
dec(mpt1.y);
end;
mpt1.y := p1.y + 1;
while (mpt1.y < MAP_HLENGTH) and (isEmptyPt(mpt1)) do
begin
mpt2.y := mpt1.y;
if isEmptyPt(mpt2) then
result := CanLine(mpt1, mpt2) and CanLine(mpt2, p2);
if result then
exit;
inc(mpt1.y);
end;
end;
...{*************************************************
函数名: TLineGame.CanLine
描 述: 判断两点是否可以直线相连
参 数: P1, P2: TPoint
返回值: Boolean
*************************************************}
function TLineGame.CanLine(P1, P2: TPoint): Boolean;
var
i: integer;
begin
result := false;
// 横1....1
if (p1.y = p2.Y) then
begin
if p1.x > p2.X then
begin
result := CanLine(P2, P1);
end
else
begin
result := true;
for i := p1.X + 1 to p2.X - 1 do
begin
result := Maps[i, p1.Y] = -2;
if not result then
exit;
end;
end;
end
else if (p1.x = p2.x) then // 竖
begin
if p1.y > p2.y then
begin
result := CanLine(P2, P1);
end
else
begin
result := true;
for i := p1.y + 1 to p2.y - 1 do
begin
result := Maps[p1.x, i] = -2;
if not result then
exit;
end;
end;
end;
end;
...{*************************************************
函数名: TLineGame.isEmptyPt
描 述: 是否空白点
参 数: pt: TPoint
返回值: boolean
*************************************************}
function TLineGame.isEmptyPt(pt: TPoint): boolean;
begin
result := Maps[pt.X, pt.Y] = -2;
end;
...{*************************************************
函数名: TLineGame.Create
描 述: 创建TlineGame类
参 数: None
返回值: None
*************************************************}
constructor TLineGame.Create;
var
i: integer;
Res: TResourceStream;
begin
LineMap := TStringList.Create;
Res := TResourceStream.Create(HInstance,'SRC1', PChar('FILE1'));
LineMap.LoadFromStream(res);
Res.Free;
for i := 1 to MAPCOUNT do
begin
ptLines[i] := TList.Create;
end;
end;
...{*************************************************
函数名: TLineGame.Destroy
描 述: 消耗TLineGame类
参 数: None
返回值: None
*************************************************}
destructor TLineGame.Destroy;
var
i: integer;
begin
LineMap.Free;
for i := MAPCOUNT downto 1 do
begin
ptLines[i].Free;
end;
SetKbHook(0);
end;
...{*************************************************
函数名: TLineGame.SetPtLines
描 述: 根据矩阵设置对子队列
参 数: None
返回值: None
*************************************************}
procedure TLineGame.SetPtLines;
var
i, j: integer;
pt: pPoint;
mapValue: integer;
begin
try
for i := 1 to MAPCOUNT do
for j := ptLines[i].Count - 1 downto 0 do
begin
Dispose(ptLines[i].Items[j]);
ptLines[i].Delete(j);
end;
for i := 0 to MAP_VLENGTH - 1 do
for j := 0 to MAP_HLENGTH - 1 do
begin
new(pt);
pt.X := i;
pt.Y := j;
mapValue := Maps[i, j];
if mapValue <> -2 then
begin
ptLines[mapValue].Add(pt);
end;
end;
except
end;
end;
...{*************************************************
函数名: TLineGame.isSameMap
描 述: 判断两点是否相似，如相似则认为是同一类型的点
参 数: Color1, Color2: integer
返回值: boolean
*************************************************}
function TLineGame.isSameMap(Color1, Color2: integer): boolean;
var
r1, g1, b1: Integer;
r2, g2, b2: Integer;
begin
r1 := GetRValue(Color1);
g1 := GetGValue(Color1);
b1 := GetBValue(Color1);
r2 := GetRValue(Color2);
g2 := GetGValue(Color2);
b2 := GetBValue(Color2);
Result := (abs(r1 - r2) < 5) and (abs(g1 - g2) < 5) and (abs(b1 - b2) < 5)
end;
...{*************************************************
函数名: TLineGame.GetMapIndex
描 述: 根据颜色值，判断其所属的类型队列的位置
参 数: Color: integer
返回值: integer
*************************************************}
function TLineGame.GetMapIndex(Color: integer): integer;
var
i: integer;
Color1: integer;
begin
result := -2;
for i := 0 to LineMap.Count - 1 do
begin
Color1 := StrToInt(LineMap.Names[i]);
if isSameMap(Color, Color1) then
begin
result := strtoint(LineMap.ValueFromIndex[i]);
exit;
end;
end;
end;
...{*************************************************
函数名: TLineGame.LeftMapCount
描 述: 计算ptLine中剩余的点数
参 数: None
返回值: integer
*************************************************}
function TLineGame.LeftMapCount: integer;
var
i: integer;
begin
Result := 0;
for i := 1 to MAPCOUNT do
begin
inc(Result, ptLines[i].Count);
end;
end;
...{*************************************************
函数名: TLineGame.GetBox
描 述: 获取游戏界面布局数据
参 数: None
返回值: None
*************************************************}
procedure TLineGame.GetBox;
var
i, j: Integer;
color1: Cardinal;
begin
gh := FindWindow(nil, PChar('QQ连连看'));
//生成数组
GetWindowRect(gh, Recta);
for i := 0 to MAP_VLENGTH - 1 do
for j := 0 to MAP_HLENGTH - 1 do
begin
color1 := GetColorMx(j, i);
if isBackGround(color1) then
maps[i, j] := -2
else
maps[i, j] := GetMapIndex(color1);
end;
end;
...{*************************************************
函数名: TLineGame.isBackGround
描 述: 判断是否游戏中的背景
参 数: Color: Integer
返回值: boolean
*************************************************}
function TLineGame.isBackGround(Color: Integer): boolean;
var
r, g, b: Integer;
begin
r := GetRValue(Color);
g := GetGValue(Color);
b := GetBValue(Color);
Result := (Abs(110 - r) < 20) and (abs(154 - g) < 20) and (abs(236 - b) < 20);
end;
...{*************************************************
函数名: TLineGame.GetMapPos
描 述: 获取对子矩阵中点在游戏中的位置
参 数: i, j: integer
返回值: Tpoint
*************************************************}
function TLineGame.GetMapPos(i, j: integer): Tpoint;
begin
result.x := Recta.Left + gLeft + 16 + hwidth * j;
result.y := recta.Top + gTop + 18 + vwidth * i;
end;
...{*************************************************
函数名: TLineGame.SendMouse
描 述: 模拟发送消除对子的消息
参 数: x1, y1, x2, y2: Integer
返回值: None
*************************************************}
procedure TLineGame.SendMouse(x1, y1, x2, y2: Integer);
var
pos1, pos2: TPoint;
Recta: TRect;
begin
GetWindowRect(gh, Recta);
pos1 := GetMapPos(x1, y1);
PostMessage(gh, WM_LBUTTONDOWN, 0, MakeLong(pos1.X - Recta.Left, pos1.y -
Recta.Top));
Pos2 := GetMapPos(x2, y2);
PostMessage(gh, WM_LBUTTONDOWN, 0, MakeLong(pos2.X - Recta.Left, pos2.y -
Recta.Top));
end;
...{*************************************************
函数名: TLineGame.RunStep
描 述: 消除一组对子
参 数:
返回值: None
*************************************************}
procedure TLineGame.RunStep();
var
p1, p2: TPoint;
begin
gh := FindWindow(nil, PChar('QQ连连看'));
SetMemData(gh);
GetBox;
SetPtLines;
if Search(p1, p2) then
begin
SendMouse(p1.X, p1.Y, p2.X, p2.Y);
end;
end;
...{*************************************************
函数名: TLineGame.KillAll
描 述: 消除所有对子
参 数:
返回值: None
*************************************************}
procedure TLineGame.KillAll();
var
p1, p2: TPoint;
SearchFail: Boolean;
begin
gh := FindWindow(nil, PChar('QQ连连看'));
SetMemData(gh);
GetBox;
SetPtLines;
repeat
SearchFail := true;
while Search(p1, p2) do
begin
SearchFail := False;
SendMouse(p1.X, p1.Y, p2.X, p2.Y);
end;
until (LeftMapCount = 0) or SearchFail;
end;
...{*************************************************
函数名: TLineGame.AutoStart
描 述: 自动开始游戏
参 数: None
返回值: None
*************************************************}
procedure TLineGame.AutoStart;
begin
gh := FindWindow(nil, PChar('QQ连连看'));
PostMessage(gh, WM_LBUTTONDOWN, 0, MakeLong(684, 532));
PostMessage(gh, WM_LBUTTONUP, 0, MakeLong(684, 532));
end;
procedure TLineGame.SetMemData(hnd: THandle);
var ThreadProcessID:integer;
begin
ThreadProcessID:=GetWindowThreadProcessId(hnd,nil);
if ThreadProcessID=FGameThreadID then exit;
FGameThreadID:=ThreadProcessID ;
SetKbHook(FGameThreadID);
end;
end.
QQLLK.dpr
...{*************************************************
Copyright (C), 2004, 风月工作室.
作者: 追风逐月
版本: 1.0
日期: 2005年02月01日
描述:
修改历史:
徐明 2005/02/01 1.0 创建该文件
...
*************************************************}
...{$J+}
program QQLLK;
uses
Windows,
Messages,
SysUtils,
ShellAPI,
LineGame in 'LineGame.pas';
...{$R qqllk.res}
const
////////////////
//资源常量定义// ;不要修改！
////////////////
MAINICON = 'MAINICON';
IDD_MAINDLG = 1000;
MAIN_SINGLE = 1002;
MAIN_ALL = 1003;
MAIN_OPTION = 1006;
MAIN_ABOUT = 1001;
MAIN_EXIT = 1004;
IDD_ABOUTDLG = 3000;
ABOUT_OK = 3001;
ABOUT_CLOSE = 3002;
ABOUT_FILE = 3003;
ABOUT_AUTHOR = 3004;
ABOUT_MEMO = 3005;
IDD_OPTIONDLG = 2000;
OPTION_OK = 2001;
OPTION_CANCEL = 2002;
OPTION_ABOUT = 2003;
OPTION_CLOSE = 2004;
OPTION_AUTOSTART = 1000;
OPTION_AUTOTOOLS = 1001;
OPTION_RANDOM = 1006;
OPTION_COMPUTER = 1007;
OPTION_TIMER = 1008;
const
////////////////
//常量数据声明//
////////////////
(*颜色设定*)
//clBackground = $8B190B; //背景颜色
clBackground = $87D34; //背景颜色
clText = $E4E4E4; //文字颜色
//clFrom = $871200; //标题栏渐变起始颜色
//clTo = $808080; //标题栏渐变结束颜色
clFrom = $87D34; //标题栏渐变起始颜色
clTo = $808080; //标题栏渐变结束颜色
ID_HOTKEYF2 = 200; //热键F2
ID_HOTKEYF3 = 300; //热键F3
ID_HOTKEYCTRLF4 = 400; //热键CTRL+F4
szMainCaption = 'QQ连连看外挂';
...{*选项对话框*}
szOptionCaption = '选项'; //关于对话框标题
(*关于对话框*)
szAboutCaption = '关于 QQ连连看外挂'; //关于对话框标题
szFile = '版本 1.1.0.0'; //注册机说明
szAuthor = '『由[追风逐月]编写』'; //注册机作者
szGreet = //字幕内容每行不要超过32个字符(16个汉字)
'本软件由风月工作室出品'#10#10 + '〖联系方式〗'#10#10'coolchyni@gmail.com'#10#10+
'〖快捷键〗'#10#10+'F2:消除一组对子'#10'F3:消除所有对子'#10'CTRL+F4:显示/隐藏窗口'#10#10+
'〖特别感谢〗'#10#10+
'各位QQ游戏爱好者'#10'我的哥们'#10'以及所有曾帮助过我的人'#10#10 +
'〖免责声明〗'#10#10'本软件属于免费软件'#10'可以自由使用'#10'由此造成的一切后果（如QQ号被封）'#10'均与作者无关'#10#10 +
'〖版本信息〗'#10#10'[1.0.0.0]'#10'实现外挂程序基本功能'#10'[1.1.0.0]'#10'使用内存补丁的方法，'#10'去掉了原程序包中的连连看替换文件.'#10' ' ;
var
BKC: HBRUSH; //背景画刷
//h_Cur: HCURSOR; //鼠标指针句柄
h_Inst: HINST; //程序图标句柄
h_Icon: HICON; //实例句柄
h_mainDlg: HWND;
g_AutoStart: boolean = false; //自动开始
g_AutoTools: boolean = false; //自动使用工具
g_Random: boolean = false; //隐藏窗口
g_Computer: boolean = false; //电脑托管
g_timer: array[0..254] of char = '1000'; //消除频率
g_internal:integer=1000; //定时间隔
LineGames: TLineGame; //游戏类
function LinesInStr(srcStr: string): smallint;
var
i: integer;
begin
Result := 1;
for i := 0 to Length(srcStr) - 1 do
if srcStr[i] = #10 then
Result := Result + 1;
if Result > 1 then
Result := Result - 1;
end;
//////////////////////////////////////////////////////////////////
//动态显示窗体函数
procedure AnimateShow(hDlg: HWND);
var
Rt: TRECT;
x, y, i: smallint;
h_Rgn: HRGN;
begin
ShowWindow(hDlg, SW_HIDE);
GetWindowRect(hDlg, Rt);
x := (Rt.right - Rt.left) div 2;
y := (Rt.bottom - Rt.top) div 2;
for i := 0 to (Rt.Right div 2) do
begin
h_Rgn := CreateRectRgn(x - i, y - i, x + i, y + i);
SetWindowRgn(hDlg, h_Rgn, True);
ShowWindow(hDlg, SW_SHOW);
DeleteObject(h_Rgn);
end;
SetWindowPos(hDlg, HWND_TOPMOST, rt.Left, rt.Top, rt.Right - rt.Left, rt.Bottom
- rt.Top, 0);
end;
//////////////////////////////////////////////////////////////
//绘制标题栏函数
//hDC: 绘制窗体的设备环境句柄
//hIco: 标题栏图标句柄
//szCaption: 标题栏标题
//rect: 标题栏矩形区域
//clBegin: 标题栏渐变起始颜色
//clEnd: 标题栏渐变结束颜色
procedure PaintCaption(h_DC: HDC; h_Ico: HICON; const szCaption: string; rect:
TRECT;
clBegin: COLORREF; clEnd: COLORREF);
var
brush: HBRUSH;
_logbrush: LOGBRUSH; //上色画刷
colorrect: TRECT; //上色矩形区域
h_font: HFONT; //标题栏字体
Haf, i: smallint;
R, G, B, fr, fg, fb, dr, dg, db: smallint;
begin
fr := GetRValue(clFrom); //分解颜色
fg := GetGValue(clFrom);
fb := GetBValue(clFrom);
dr := GetRValue(clTo);
dg := GetGValue(clTo);
db := GetBValue(clTo);
Haf := (rect.right - rect.left) div 2; //计算标题栏矩形区域中心
//设定上色矩形区域高度
colorrect.top := 0;
colorrect.bottom := rect.bottom - rect.top;
//建立渐变上色画刷
_logbrush.lbStyle := BS_SOLID;
_logbrush.lbHatch := 0;
for i := 0 to Haf do
begin
//设定左半上色矩形区域一次填充位置
colorrect.left := MulDiv(i, Haf, Haf);
colorrect.right := MulDiv(i + 1, Haf, Haf);
//颜色渐变
R := fr + MulDiv(i, dr, Haf);
G := fg + MulDiv(i, dg, Haf);
B := fb + MulDiv(i, db, Haf);
if (R > 255) then
R := 255;
if (G > 255) then
G := 255;
if (B > 255) then
B := 255;
_logbrush.lbColor := RGB(R, G, B);
brush := CreateBrushIndirect(_logbrush);
FillRect(h_DC, colorrect, brush); //填充左半区域
//设定右半上色矩形区域一次填充位置
colorrect.left := (rect.right - rect.left) - (MulDiv(i, Haf, Haf));
colorrect.right := (rect.right - rect.left) - (MulDiv(i + 1, Haf, Haf));
FillRect(h_DC, colorrect, brush); //填充右半区域
DeleteObject(brush);
end;
_logbrush.lbColor := $9E6A54;
brush := CreateBrushIndirect(_logbrush);
FrameRect(h_DC, rect, brush); //绘制标题栏边框
DeleteObject(brush);
SetTextColor(h_DC, $FFFFFF);
SetBkMode(h_DC, TRANSPARENT); //设定标题栏字体属性
rect.left := 2;
rect.top := 2;
rect.bottom := rect.Bottom - 2;
h_font := CreateFont(-12, 0, 0, 0, 700, 0, 0, 0, DEFAULT_CHARSET,
OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY,
DEFAULT_PITCH or FF_DONTCARE, '宋体');
//(宋体9号粗体字)
SelectObject(h_DC, h_font);
if h_Ico <> 0 then //若有图标则会制图标
begin
DrawIconEx(h_DC, 2, 2, h_Ico, 16, 16, 0, 0, DI_NORMAL);
rect.left := 20;
end;
//绘制标题栏标题
DrawText(h_DC, PChar(szCaption), -1, rect, DT_SINGLELINE or DT_VCENTER);
DeleteObject(h_font);
end;
//////////////////////////////////////////////////////////////
//绘制按钮函数
//pdis: 绘制内容结构指针
procedure DrawButton(pdis: PDRAWITEMSTRUCT);
var
szText: array[0..9] of char; //按钮文字
begin
FillRect(pdis.hDC, pdis.rcItem, BKC); //以背景色填充按钮
SetTextColor(pdis.hDC, clText);
SetBkMode(pdis.hDC, TRANSPARENT);
//尚未点击，绘制按钮边框-突起状态
DrawEdge(pdis.hDC, pdis.rcItem, BDR_RAISEDOUTER, BF_RECT);
GetWindowText(pdis.hwndItem, szText, sizeof(szText));
DrawText(pdis.hDC, szText, -1, pdis.rcItem, DT_SINGLELINE or DT_CENTER or
DT_VCENTER);
//已被按下，绘制按钮边框-凹陷状态
//if (pdis.itemState and ODS_SELECTED)=ODS_SELECTED then
if (pdis.itemState and ODS_SELECTED) <> 0 then
begin
SetTextColor(pdis.hDC, $00DDFF);
DrawText(pdis.hDC, szText, -1, pdis.rcItem, DT_SINGLELINE or DT_CENTER or
DT_VCENTER);
DrawEdge(pdis.hDC, pdis.rcItem, BDR_SUNKENOUTER, BF_RECT);
end;
end;
function ScrollProc(h_Wnd: HWND; Msg, wParam, lParam: DWORD): LRESULT; stdcall;
var
h_DC: HDC;
ps: TPAINTSTRUCT;
rc: TRECT;
h_font: HFONT;
begin
case Msg of
WM_PAINT:
begin
//绘制字幕内容
h_DC := BeginPaint(h_Wnd, ps);
GetClientRect(h_Wnd, rc);
SetTextColor(h_DC, clText);
SetBkMode(h_DC, TRANSPARENT);
h_font := CreateFont(-12, 0, 0, 0, 0, 0, 0, 0, DEFAULT_CHARSET,
OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH
or FF_DONTCARE, '宋体');
SelectObject(h_DC, h_font);
DrawText(h_DC, szGreet, -1, rc, DT_CENTER);
EndPaint(h_Wnd, ps);
DeleteObject(h_font);
end;
else
begin
//l:=GetWindowLong(h_Wnd,GWL_USERDATA);
//CallWindowProc(@l,h_Wnd,Msg,wParam,lParam);
end;
end;
result := 1;
end;
function AboutProc(hDlg: HWND; Msg, wParam, lParam: DWORD): LRESULT; stdcall;
const
rcCaption: TRECT = ();
i: smallint = 0;
w: smallint = 0;
h: smallint = 0;
h_Memo: HWND = 0;
memo: HWND = 0;
lines: smallint = 1; //字幕行数
var
h_dc: HDC;
ps: TPAINTSTRUCT;
pdis: PDRAWITEMSTRUCT;
pt: TPOINT;
rcMemo: TRECT;
lUser: integer;
h_Font: HFONT;
h_File: HWND;
begin
case Msg of
WM_INITDIALOG:
begin
GetClientRect(hDlg, rcCaption);
rcCaption.bottom := rcCaption.top + 20;
h_Memo := GetDlgItem(hDlg, ABOUT_MEMO);
h_File := GetDlgItem(hDlg, ABOUT_FILE);
h_Font := CreateFont(-12, 0, 0, 0, 700, 0, 0, 0, DEFAULT_CHARSET,
OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH
or FF_DONTCARE, '宋体');
SendMessage(h_File, WM_SETFONT, h_Font, 0);
SetDlgItemText(hDlg, ABOUT_FILE, szFile);
SetDlgItemText(hDlg, ABOUT_AUTHOR, szAuthor);
SetWindowText(hDlg, szAboutCaption);
GetClientRect(h_Memo, rcMemo); //得到字幕显示区域大小
w := rcMemo.right - rcMemo.left;
h := rcMemo.bottom - rcMemo.top;
i := h;
lines := LinesInStr(szGreet); //计算字幕行数
//建立显示字幕子窗体
memo := CreateWindow('Static', '', WS_VISIBLE or WS_CHILD or SS_CENTER,
0, h, w, 12 * lines, h_Memo, 0, h_Inst, nil);
//设定子窗体消息处理函数
lUser := SetWindowLong(memo, GWL_WNDPROC, integer(@ScrollProc));
SetWindowLong(memo, GWL_USERDATA, lUser);
AnimateShow(hDlg);
SetTimer(hDlg, 168, 80, nil); //设定定时器每80毫秒触发一次
result := 1;
end;
WM_TIMER:
begin
//定时器触发时移动子窗体，形成字幕
Sleep(20);
i := i - 1;
SetWindowPos(memo, 0, 0, i, w, 12 * lines, 0);
if (-(i + (12 * lines)) > 0) then
i := h; //字幕到达尾部时，重新开始循环
end;
WM_LBUTTONDOWN:
begin
pt.x := LOWORD(lParam);
pt.y := HIWORD(lParam);
if (PtInRect(rcCaption, pt)) then
PostMessage(hDlg, WM_NCLBUTTONDOWN, HTCAPTION, 0);
end;
WM_PAINT:
begin
h_dc := BeginPaint(hDlg, ps);
PaintCaption(h_dc, h_Icon, szAboutCaption, rcCaption, clFrom, clTo);
EndPaint(hDlg, ps);
end;
WM_COMMAND:
begin
case wParam of
ABOUT_OK:
begin
KillTimer(hDlg, 168); //销毁定时器
EndDialog(hDlg, 0);
end;
ABOUT_CLOSE:
begin
KillTimer(hDlg, 168); //销毁定时器
EndDialog(hDlg, 0);
end;
end;
result := 0;
end;
WM_DRAWITEM:
begin
pdis := PDRAWITEMSTRUCT(lParam);
DrawButton(pdis);
Result := 0;
end;
///////////////////////////////////////////////////
//响应绘制窗体内容消息
WM_CTLCOLORDLG:
begin
SetTextColor(wParam, clText);
SetBkMode(wParam, TRANSPARENT);
Result := BKC;
end;
WM_CTLCOLORSTATIC:
begin
SetTextColor(wParam, clText);
SetBkMode(wParam, TRANSPARENT);
Result := BKC;
end;
else
Result := 0;
end;
end;
function OptionProc(hDlg: HWND; Msg, wParam, lParam: DWORD): LRESULT; stdcall;
const
rcCaption: TRECT = ();
i: smallint = 0;
w: smallint = 0;
h: smallint = 0;
h_Memo: HWND = 0;
memo: HWND = 0;
lines: smallint = 1; //字幕行数
var
h_dc: HDC;
ps: TPAINTSTRUCT;
pdis: PDRAWITEMSTRUCT;
pt: TPOINT;
h_Font: HFONT;
h_File: HWND;
e: integer;
begin
case Msg of
WM_INITDIALOG:
begin
GetClientRect(hDlg, rcCaption);
rcCaption.bottom := rcCaption.top + 20;
h_Memo := GetDlgItem(hDlg, ABOUT_MEMO);
h_File := GetDlgItem(hDlg, ABOUT_FILE);
h_Font := CreateFont(-12, 0, 0, 0, 700, 0, 0, 0, DEFAULT_CHARSET,
OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH
or FF_DONTCARE, '宋体');
SendMessage(h_File, WM_SETFONT, h_Font, 0);
CheckDlgButton(hdlg, OPTION_AUTOSTART, ord(g_AutoStart));
CheckDlgButton(hdlg, OPTION_AUTOTOOLS, ord(g_AutoTools));
CheckDlgButton(hdlg, OPTION_RANDOM, ord(g_Random));
CheckDlgButton(hdlg, OPTION_COMPUTER, ord(g_Computer));
SetDlgItemText(hDlg, OPTION_TIMER, g_timer);
result := 1;
end;
WM_LBUTTONDOWN:
begin
pt.x := LOWORD(lParam);
pt.y := HIWORD(lParam);
if (PtInRect(rcCaption, pt)) then
PostMessage(hDlg, WM_NCLBUTTONDOWN, HTCAPTION, 0);
end;
WM_PAINT:
begin
h_dc := BeginPaint(hDlg, ps);
PaintCaption(h_dc, h_Icon, szOptionCaption, rcCaption, clFrom, clTo);
EndPaint(hDlg, ps);
end;
WM_COMMAND:
begin
case wParam of
OPTION_OK:
begin
g_AutoStart := IsDlgButtonChecked(hDlg, OPTION_AUTOSTART) =
BST_CHECKED;
g_AutoTools := IsDlgButtonChecked(hDlg, OPTION_AUTOTOOLS) =
BST_CHECKED;
g_Random := IsDlgButtonChecked(hDlg, OPTION_RANDOM) =
BST_CHECKED;
g_Computer := IsDlgButtonChecked(hDlg, OPTION_COMPUTER) =
BST_CHECKED;
GetDlgItemText(hDlg, OPTION_TIMER, g_timer, 255);
//LineGames.AutoStart;
Val(g_timer, g_internal, E);
if (E <> 0) or (g_internal < 500) or (g_internal > 10000) then
begin
g_internal := 1000;
MessageBox(hDlg, pchar('请输入一个有效的整数（500~10000）!'),
pchar('输入错误'),
MB_ICONERROR);
exit;
end;
if g_autostart or g_Computer then
SetTimer(h_mainDlg, 169, g_internal, nil)
else
KillTimer(h_mainDlg, 169);
//设定定时器每1000毫秒触发一次
EndDialog(hDlg, 0);
end;
OPTION_ABOUT: DialogBox(h_Inst, LPCTSTR(IDD_ABOUTDLG), hDlg,
@AboutProc);
OPTION_CANCEL, OPTION_CLOSE:
begin
EndDialog(hDlg, 0);
end;
end;
result := 0;
end;
WM_DRAWITEM:
begin
pdis := PDRAWITEMSTRUCT(lParam);
DrawButton(pdis);
Result := 0;
end;
///////////////////////////////////////////////////
//响应绘制窗体内容消息
WM_CTLCOLORDLG:
begin
SetTextColor(wParam, clText);
SetBkMode(wParam, TRANSPARENT);
Result := BKC;
end;
WM_CTLCOLORSTATIC:
begin
SetTextColor(wParam, clText);
SetBkMode(wParam, TRANSPARENT);
Result := BKC;
end;
else
Result := 0;
end;
end;
function MainProc(hDlg: HWND; Msg, wParam, lParam: DWORD): LRESULT; stdcall;
const
rcCaption: TRECT = ();
var
h_dc: HDC;
ps: TPAINTSTRUCT;
pdis: PDRAWITEMSTRUCT;
pt: TPOINT;
begin
case Msg of
WM_INITDIALOG:
begin
h_mainDlg := hDlg;
GetClientRect(hDlg, rcCaption);
rcCaption.bottom := rcCaption.top + 20;
SetWindowText(hDlg, szMainCaption);
AnimateShow(hDlg);
if (RegisterHotKey(hDlg, ID_HOTKEYF2, 0, VK_F2) = false) then
begin
//hotkey注册
//失败了的话...
MessageBox(hDlg, pchar('注册热键F2失败!'), pchar('Error'),
MB_ICONERROR);
PostQuitMessage(0);
end;
if (RegisterHotKey(hDlg, ID_HOTKEYF3, 0, VK_F3) = false) then
begin
//hotkey注册
//失败了的话...
MessageBox(hDlg, pchar('注册热键F3失败!'), pchar('Error'),
MB_ICONERROR);
PostQuitMessage(0);
end;
if (RegisterHotKey(hDlg, ID_HOTKEYCTRLF4, MOD_CONTROL, VK_F4) = false)
then
begin
//hotkey注册
//失败了的话...
MessageBox(hDlg, pchar('注册热键CTRL+F4失败!'), pchar('Error'),
MB_ICONERROR);
PostQuitMessage(0);
end;
result := 1;
end;
WM_HOTKEY: //处理WM_HOTKEY消息
begin
case HIWORD(lParam) of
VK_F3: LineGames.KillAll;
vk_F2: LineGames.RunStep;
VK_F4:
begin
if IsWindowVisible(hDlg) then
showWindow(hDlg, SW_HIDE)
else
showWindow(hDlg, SW_SHOW);
end;
end;
result := 0;
end;
WM_LBUTTONDOWN:
begin
//响应鼠标左键按下消息，若在标题栏内则使窗体移动
pt.x := LOWORD(lParam);
pt.y := HIWORD(lParam);
if PtInRect(rcCaption, pt) then
PostMessage(hDlg, WM_NCLBUTTONDOWN, HTCAPTION, 0);
end;
WM_PAINT:
begin
//响应绘制消息，绘制标题栏
h_DC := BeginPaint(hDlg, ps);
PaintCaption(h_DC, h_Icon, szMainCaption, rcCaption, clFrom, clTo);
EndPaint(hDlg, ps);
end;
WM_COMMAND:
begin
case wParam of
MAIN_SINGLE:
begin
LineGames.RunStep;
end;
MAIN_ALL: LineGames.KillAll();
MAIN_OPTION: DialogBox(h_Inst, LPCTSTR(IDD_OPTIONDLG), hDlg,
@OptionProc);
MAIN_ABOUT:
DialogBox(h_Inst, LPCTSTR(IDD_ABOUTDLG), hDlg, @AboutProc);
MAIN_EXIT: EndDialog(hDlg, 0);
end;
result := 0;
end;
WM_DRAWITEM:
begin
pdis := PDRAWITEMSTRUCT(lParam);
DrawButton(pdis);
Result := 0;
end;
WM_TIMER:
begin
//定时器触发时移动子窗体，形成字幕
if g_AutoStart then
LineGames.AutoStart;
if g_Computer then
LineGames.RunStep;
if g_Random then
SetTimer(hDlg,169,500+Random(g_internal-500),nil);
end;
///////////////////////////////////////////////////
//响应绘制窗体内容消息
WM_CTLCOLORDLG:
begin
SetTextColor(wParam, clText);
SetBkMode(wParam, TRANSPARENT);
Result := BKC;
end;
WM_CTLCOLORSTATIC:
begin
SetTextColor(wParam, clText);
SetBkMode(wParam, TRANSPARENT);
Result := BKC;
end;
WM_DESTROY:
begin
UnregisterHotKey(hDlg, ID_HOTKEYF2); //用完记得要收回
UnregisterHotKey(hDlg, ID_HOTKEYF3); //用完记得要收回
UnregisterHotKey(hDlg, ID_HOTKEYCTRLF4); //用完记得要收回
KillTimer(hDlg, 169);
PostQuitMessage(0);
end;
else
Result := 0;
end;
end;
//////////////////////////////////////////////////////////////////
//程序入口函数
//
begin
h_Inst := GetModuleHandle(nil); //保存实例句柄
BKC := CreateSolidBrush(clBackground); //建立背景画刷
//h_Cur := LoadCursor(h_Inst, LPCTSTR(IDC_HAND)); //载入鼠标指针
h_Icon := LoadIcon(h_Inst, LPCTSTR(MAINICON)); //载入程序图标
//显示协议对话框
LineGames := TLineGame.Create;
DialogBox(h_Inst, LPCTSTR(IDD_MAINDLG), 0, @MainProc);
LineGames.Free;
DeleteObject(BKC); //释放背景画刷
//退出程序
ExitProcess(0);
end.
内容来自用户分享和网络整理，不保证内容的准确性，如有侵权内容，可联系管理员处理 
相关文章推荐
- Phenix 分布式应用开发平台 for Delphi (源码) 发布
- 另一个HookAPI 源码,来自EurekaLog for Delphi中的EHook.pas
- delphi for php 支持中文的方法
- CodeGear开发者日投影片和Delphi 2007 For Win32范例录像
- pjsip使用最新源码编译 for android
- Delphi for PHP 评测
- GNU Gettext for Delphi, C++ and Kylix
- RemObjects SDK Source For Delphi XE7
- Delphi/400 and Delphi/400 for PHP
- MySQL5.7.18 for Linux7.2 源码安装
- 《GOF设计模式》—策略(STRATEGY)—Delphi源码示例：文本换行
- Delphi之东进模拟语音卡(D160A)可复用源码
- CodeGear.Delphi.for.PHP 2.1.0.1083 最新版本(包含破解)
- Delphi之东进数字语音卡(SS1)可复用源码
- Delphi之三汇模拟语音卡(SHT-8B/PCI/FAX)可复用源码
- 《GOF设计模式》—观察者（OBSERVER）—Delphi源码示例：图形用户界面工具箱
- Acro Multi-Language Suit for Delphi Win32升级到4.0版本
- 简易文本编辑器（Delphi源码）
- 《GOF设计模式》—访问者（VISITOR）—Delphi源码示例：设备