<#include file=amzHonor.inc>
Eggcentric Home

Keyboard Hook


Download KeyboardHook.pas




Description

  TKeyboardCallback =
      procedure(code: Integer; wparam: WPARAM; lparam: LPARAM) of object;

  TKeyboardHook = class(TComponent)
    {Source at bottom}
  published
    { Published declarations }
    property OnCallback: TKeyboardCallBack read FOnCallback write SetOnCallback;
  end;
Catching a keyboard stroke for your application requires a call to the windows api function SetWindowsHookEx.

Using this function will allow you to specify a callback procedure for the keystrokes.

You have 2 options, you can make a system wide hook or a hook for a particular thread.

If you make a system wide hook or specify a thread that exists in a different process then you must use a seperate DLL.

The provided source is for your applications main thread, therefore is not a system wide hook.

Install the below component, drop it on your form, then assign the OnCallback event.

You can look into windows help for "KeyboardProc" and it will explain the parameters.

Here is an implementation I am using in a production application that responds to the space bar: 

procedure TForm_LibraryImageSelect.KeyboardHook1Callback(code, wparam, 
  lparam: Integer); 
begin 
  if (wParam = VK_SPACE) and ((lparam and (1 shl 30)) > 0) then 
    SendMoveNextLibImage(dNext); 
end;


Good luck,

Here is the source for the component: 

unit KeyboardHook;

{
  By William Egge
  Sep 20, 2002
  egge@eggcentric.com
  http://www.eggcentric.com

  This code may be used/modified however you wish.
}

interface

uses
  Windows, Classes;

type
  TCallbackThunk = packed record
    POPEDX: Byte;
    MOVEAX: Byte;
    SelfPtr: Pointer;
    PUSHEAX: Byte;
    PUSHEDX: Byte;
    JMP: Byte;
    JmpOffset: Integer;
  end;

  // See windows help on KeyboardProc
  // Or press F1 while your cursor is on "KeyboardProc"
  TKeyboardCallback =
      procedure(code: Integer; wparam: WPARAM; lparam: LPARAM) of object;

  TKeyboardHook = class(TComponent)
  private
    { Private declarations }
    FHook: HHook;
    FThunk: TCallbackThunk;
    FOnCallback: TKeyboardCallBack;
    function CallBack(code: Integer; wparam: WPARAM; lparam: LPARAM): LRESULT
        stdcall;
    procedure SetOnCallback(const Value: TKeyboardCallBack);
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    { Published declarations }
    property OnCallback: TKeyboardCallBack read FOnCallback write SetOnCallback;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('EggMisc', [TKeyboardHook]);
end;

{ TKeyboardHook }

function TKeyboardHook.CallBack(code: Integer; wparam: WPARAM;
  lparam: LPARAM): LRESULT; 
begin
  if Code < 0 then 
    Result:= CallNextHookEx(FHook, Code, wparam, lparam) 
  else
  begin
    if Assigned(FOnCallback) then
      FOnCallback(Code, wParam, lParam); 
    Result:= 0; 
  end; 
end; 

constructor TKeyboardHook.Create(AOwner: TComponent); 
begin 
  inherited Create(AOwner);
  FThunk.POPEDX:= $5A; 
  FThunk.MOVEAX:= $B8; 
  FThunk.SelfPtr:= Self; 
  FThunk.PUSHEAX:= $50; 
  FThunk.PUSHEDX:= $52; 
  FThunk.JMP:= $E9;
  FThunk.JmpOffset:= Integer(@TKeyboardHook.Callback)-Integer(@FThunk.JMP)-5; 
  FHook:= SetWindowsHookEx(WH_KEYBOARD, TFNHookProc(@FThunk), 0, MainThreadID);
end; 

destructor TKeyboardHook.Destroy; 
begin 
  UnhookWindowsHookEx(FHook); 
  inherited; 
end; 

procedure TKeyboardHook.SetOnCallback(const Value: TKeyboardCallBack);
begin
  FOnCallback := Value;
end;

end.