VCL开发时实现按任意键继续

昨天群里有人问起了这个问题，一下子自己也意识到，这是个有意思的问题，所以就开始想了想。

在DOS程序下都可以很容易实现，可是在VCL状态 下呢，找了找资料Delphi自身不提共这样的功能，所有，只好自己写吧，应该很容易吧。反正From上有FormKeyPress等键盘事件处理过程呢。

啊，慢着，记得前段时间不知道学习什么程序时，如果光标处在可编辑控件时，这些按键消息是不会传给From的啊，那FormKeyPress还有用吗？呵呵，可想而知就不能用了，那怎么办呢，好像只能用钩子来实现吧，然后问了一下高手同事，同事也说只能用只方案。OK，那我就开始着手写了如下代码，本来很简单的东西，由于自己太菜就搞了好久。呵呵。

{
问题:我想让我的程序在运行时暂停下来，按任意键继续。如何做？
项目:此程序就是为了这个目的而写的
作者:阿永
说明:由于要考虑到程序在任何情况下都能正常工作，所以采用钩
    子技术来实现.
}

var
  Form1: TForm1;
  HookID: HHOOK;  //记录钩子的ID号，以便能够释放钩子
  PassKey: Boolean;  //用于记录按键状态
const
  WH_KEYBOARD_LL = 13;

implementation

{$R *.dfm}

function LowLevelKeyboardProc(code: Integer; wparam: wparam; lparam: lparam): LRESULT stdcall;
//钩子回调函数,具体资料参阅CSDN
begin
  Result := 1; //为了使按键不影响到其它控件，所以将返回值设为1,不让消息下传
  if (code = 0) and (GetActiveWindow() = Form1.Handle) then PassKey := True; //发生按键时改变状态,修改此处可以
  if GetActiveWindow() <> Form1.Handle then Result := CallNextHookEx(0, code, wparam, lparam); //当前窗口不活动时，将消息下传给其它程序。
end;

procedure WaiteKey();
begin
  HookID := SetWindowsHookExW(WH_KEYBOARD_LL, @LowLevelKeyboardProc, Hinstance, 0); //创建钩子
  while not PassKey do Application.ProcessMessages; //等待按键
  PassKey := False;
  if HookID <> 0 then UnhookWindowsHookEx(HookID); //释放钩子
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i: Integer;
begin
  Memo1.Clear;
  Memo1.SetFocus; //为了测试所述功能，故将光标定在Memo控件上
  for i := 0 to 1000 do
  begin
    Memo1.Lines.Add(Format('第%d行', [i]));
    if i = 500 then
    begin
      Memo1.Lines.Add('按任意键继续');
      WaiteKey();
    end
  end;
  ShowMessage('OK');
end;

本来，程序的思路是一早就想好了，但是在不知道用Application.ProcessMessages的情况下做了个死循环后程序不响应任何事件，就像死了一样，无奈之下没有了办法，没想到今早昨天问此问题的人说他处理好了，一问就是用的FormKeyPress事件中来处理的，叫他把代码贴出来一看，OMG，看到了这么一条有用的句，然后紧着一查知道，跟他功能想同的还有Application.HandleMessage,它们的区别在于 Application.HandleMessage可以让CPU的占用率不达到100%,而前者则在响应消息的情况下却不能让CPU占用率降下来。但后者可能使程序出现无法预计的错误(^_^,书上说的，反正多是吓人用的)所以我的程序中应该用后者。

同时，在这个程序中只是最简单的钩子应用，本来是应该做局部钩子的，但由于技术不到家，所以只会做全局钩子，如果做局部钩子性能和结构上可能还可以再优化。

2006-03-20

以前说过此程序可以使用局部钩子来完成，就更优化一些，所以查阅了CSDN后，改写程序如下。

{
问题:我想让我的程序在运行时暂停下来，按任意键继续。如何做？
项目:此程序就是为了这个目的而写的
作者:阿永
说明:由于要考虑到程序在任何情况下都能正常工作，所以采用钩
    子技术来实现.
附:WH_KEYBOARD_LL,WH_KEYBOARD这两个钩子不同之处是，前者为全局钩子，而后者是线程钩子（即局部钩子）
}

var
  Form1: TForm1;
  HookID: HHOOK;
  PassKey: Boolean;
const
  WH_KEYBOARD_LL = 13;

implementation

{$R *.dfm}

function LowLevelKeyboardProc(code: Integer; wparam: wparam; lparam: lparam): LRESULT stdcall;
//钩子回调函数,具体资料参阅CSDN
begin
  Result := 1; //为了使按键不影响到其它控件，所以将返回值设为1,不让消息下传
{
  if (code = 0) and (GetActiveWindow() = Form1.Handle) then PassKey := True; //发生按键时改变状态,修改此处可以
  if GetActiveWindow() <> Form1.Handle then Result := CallNextHookEx(0, code, wparam, lparam); //当前窗口不活动时，将消息下传给其它程序。
  由于修改成了局部钩子，所以不需要做如此多的判断
}
//新代码,由于是局部钩子，所以消息只在本线程内触发
  if code = 0 then PassKey := True; //发生按键时改变状态,修改此处可以

end;

procedure WaitKey();
begin
{
  HookID := SetWindowsHookExW(WH_KEYBOARD_LL, @LowLevelKeyboardProc, Hinstance, 0); //创建钩子(全局)
  HookID := SetWindowsHookExW(WH_KEYBOARD, @LowLevelKeyboardProc, Hinstance, GetCurrentThreadId()); //创建钩子(线程)
}
  HookID := SetWindowsHookExW(WH_KEYBOARD, @LowLevelKeyboardProc, Hinstance, 0); //与上句等同(线程),由于我们只需要对本线程内有效，所以只需建立局部钩子
  while not PassKey do Application.ProcessMessages; //等待按键
  PassKey := False;
  if HookID <> 0 then UnhookWindowsHookEx(HookID); //释放钩子 f
  HookID := 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i: Integer;
begin
  if HookID <> 0 then Abort; //进行保护
  Memo1.Clear;
  Memo1.SetFocus; //为了测试所述功能，故将光标定在Memo控件上
  for i := 0 to 1000 do
  begin
    Memo1.Lines.Add(Format('第%d行', [i]));
    if i = 500 then
    begin
      Memo1.Lines.Add('按任意键继续');
      WaitKey();
    end
  end;
  ShowMessage('OK');
end;