keycount.dpr

这一系列是我平时收集的pascal深入核心编程

program KeyCount;

{$R KeyCount.res}

uses Windows, Messages;

  // 引入DLL函数
function KeyboardHook_Stop(): BOOL; stdcall; external '..\DLL\KybdHk.Dll';
function KeyboardHook_Start(hwndPost: HWND; uMsgNotify: UINT; hwndEdit: HWND): BOOL; stdcall; external '..\DLL\KybdHk.Dll';

const
 // 图标资源ID
  IDI_KEYCOUNT = 101;

 // 窗体控件ID 
  IDC_START = 1000;
  IDC_STOP  = 1001;
  IDC_KEYCOUNT = 1002;
  IDC_LASTKEY  = 1003;
  IDD_KEYCOUNT = 1004;
  IDC_EDIT = 1005;

 // Purpose: 自定义消息, 通知键盘按下
 // wParam: UINT vk - Virtual keycode
 // lParam: LPARAM lParam - Keystroke flags
 // Return: 略
  UM_KEYEVENT = (WM_APP + 0);

 // 读取按键次数
function GetKeyCount(hWnd: HWND): UINT;
begin
  Result := GetWindowLong(hWnd, GWL_USERDATA);
end;

 // 保存按键次数
procedure SetKeyCount(hWnd: HWND; c: UINT);
begin
  SetWindowLong(hWnd, GWL_USERDATA, c);
end;

 // 处理WM_INITDIALOG消息
function KeyCount_OnInitDialog(hWnd, hWndFocus: HWND; lParam: LPARAM): BOOL;
begin
 // 设置窗体图标
  SendMessage(hWnd, WM_SETICON, ICON_BIG, LoadIcon(HInstance, MakeIntResource(IDI_KEYCOUNT)));

 // 设置窗体置顶
  SetWindowPos(hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);

 // 设置按钮状态
  EnableWindow(GetDlgItem(hWnd, IDC_START), TRUE);
  EnableWindow(GetDlgItem(hWnd, IDC_STOP), FALSE);

 // 按键次数清零
  SetKeyCount(hWnd, 0);

 // 接受默认焦点
  Result := TRUE;
end;

 // 处理WM_COMMAND消息
procedure KeyCount_OnCommand(hWnd: HWND; id: Integer; hWndCtl: HWND; codeNotify: UINT);
var
  hWndEdit: LongWord; // HWND
begin
  case (id) of
    IDCANCEL: // 要求退出
      begin
       // 退出前卸载钩子
        if (KeyboardHook_Stop() = FALSE) then
          MessageBox(GetActiveWindow(), 'Unable to stop keyboard hook', 'KeyCount', 0);

       // 结束模态对话框
        EndDialog(hWnd, id);
      end;

    IDC_START: // 安装钩子
      begin
        hWndEdit := GetDlgItem(hWnd, IDC_EDIT);
        if KeyboardHook_Start(hWnd, UM_KEYEVENT, hWndEdit) then
        begin
          SetDlgItemText(hWnd, IDC_LASTKEY, '');
          SetDlgItemInt(hWnd, IDC_KEYCOUNT, 0, FALSE);

          SetKeyCount(hWnd, 0);

          EnableWindow(GetDlgItem(hWnd, IDC_START), FALSE);
          EnableWindow(GetDlgItem(hWnd, IDC_STOP), TRUE);

          SetFocus(GetDlgItem(hWnd, IDC_STOP));
        end else
        begin
          MessageBox(GetActiveWindow(), 'Unable to start keyboard hook', 'KeyCount', 0);
        end;
      end;

    IDC_STOP: // 卸载钩子
      begin
        if (KeyboardHook_Stop() = FALSE) then
          MessageBox(GetActiveWindow(), 'Unable to start stop hook', 'KeyCount', 0);

        EnableWindow(GetDlgItem(hWnd, IDC_START), TRUE);
        EnableWindow(GetDlgItem(hWnd, IDC_STOP), FALSE);
        
        SetFocus(GetDlgItem(hWnd, IDC_START));
      end;
   end;
end;

 // 处理UM_KEYEVENT消息
procedure KeyCount_OnKeyEvent(hWnd: HWND; vk: UINT; lParam: LPARAM);
var
  c: Char;
  fDown: BOOL;
  uKeyCount: UINT;
  sz: array[0..128] of Char;
  L: array[0..2] of DWORD;
begin
 // 是否按下(导致的钩子调用)
  fDown := (HIWORD(lParam) and KF_UP) = 0;

 // 读取按键次数
  uKeyCount := GetKeyCount(hWnd);

 // 虚拟码转字符
  c := Char(MapVirtualKey(vk, 2));

 // 更新按键次数
  if (fDown) then Inc(uKeyCount);
  SetDlgItemInt(hWnd, IDC_KEYCOUNT, uKeyCount, FALSE);
  SetKeyCount(hWnd, uKeyCount);  

 // 填写转换列表
  if IsCharAlphaNumeric(c) then
    L[0] := DWORD(c)
  else
    L[0] := DWORD('?');
  L[1] := vk;
  if fDown then
    L[2] := DWORD(PChar('pressed'))
  else
    L[2] := DWORD(PChar('released'));

 // 作格式化转换
  wvsprintf(sz, 'char=%c, virtual key=%d <%s>', @L[0]);

 // 设置控件文字 
  SetDlgItemText(hWnd, IDC_LASTKEY, sz);
end;

 // 对话框消息处理回调
function KeyCount_DlgProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): BOOL; stdcall;
begin
  case (uMsg) of
    WM_INITDIALOG: // 初始化完成
      begin
        Result := BOOL(SetWindowLong(hWnd, DWL_MSGRESULT,
          Longint(KeyCount_OnInitDialog(hWnd, wParam, lParam))));
      end;

    WM_COMMAND: // 按钮控件通知
      begin
        KeyCount_OnCommand(hWnd, LOWORD(wParam), lParam, HIWORD(wParam));
        Result := TRUE;
      end;

    UM_KEYEVENT: // 键盘钩子通知
      begin
        KeyCount_OnKeyEvent(hWnd, wParam, lParam);
        Result := TRUE;
      end;

    else Result := FALSE; // 需要DefDlgProc处理
  end;
end;

 // 程序'主线程'入口
begin
  DialogBox(HInstance, MakeIntResource(IDD_KEYCOUNT), 0, @KeyCount_DlgProc);
end.