QQ连连看 for Delphi 源码

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.