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.