一个处理多键盘输入的组件

最近的项目中需要同时处理来自多个键盘的输入信息，使用raw input可以完美的解决这个问题。封装成一个组件，代码如下：

  1unit UnitRawInput;
  2
  3interface
  4
  5uses
  6  SysUtils, Classes,Windows,uRawInput,Forms,messages;
  7
  8
  9type
 10  TRawKeyPressEvent = procedure(sender:TObject;key:word;KeyboardHandle:THANDLE) of object;
 11
 12  TRawKeyDownEvent = TRawKeyPressEvent;
 13  TRawKeyUpEvent = TRawKeyPressEvent;  
 14type
 15  TRawInputKeyboard = class(TComponent)
 16  private
 17    FOldOnMessage:TMessageEvent;
 18    FOnRawKeyDown:TRawKeyPressEvent;
 19    FOnRawKeyUp:TRawKeyPressEvent;
 20    procedure ApplicationEventsMessage(var Msg: tagMSG; var Handled: Boolean);
 21    procedure RegisterRaw;
 22  protected
 23    procedure ProcessKeyPressMessage(var Msg: tagMSG; Keyboard:RAWKEYBOARD;KeyboardHandle:THANDLE);
 24    procedure DoRawKeyDown(Key: Word;KeyboardHandle:THANDLE);
 25    procedure DoRawKeyUp(Key: Word;KeyboardHandle:THANDLE);
 26  public
 27    constructor Create(AOwner: TComponent); override;
 28    destructor Destroy; override;
 29  published
 30    property OnRawKeyDown:TRawKeyDownEvent read  FOnRawKeyDown write FOnRawKeyDown;
 31    property OnRawKeyUp:TRawKeyUpEvent read  FOnRawKeyUp write FOnRawKeyUp;
 32  end;
 33
 34procedure Register;
 35
 36implementation
 37
 38procedure Register;
 39begin
 40  RegisterComponents('lance', [TRawInputKeyboard]);
 41end;
 42
 43{ TRawInput }
 44
 45procedure TRawInputKeyboard.ApplicationEventsMessage(var Msg: tagMSG;
 46  var Handled: Boolean);
 47var
 48  Size:    cardinal;
 49  ttagRAWINPUT: tagRAWINPUT;
 50
 51  ttagRAWKEYBOARD:tagRAWKEYBOARD;
 52  KeyboardHandle:THANDLE;
 53
 54
 55begin
 56  if   (msg.message=WM_INPUT) then
 57  begin
 58    Size:= sizeOf(RAWINPUTHEADER);
 59    ttagRAWINPUT.header.dwSize := sizeOf(RAWINPUTHEADER);
 60
 61    if GetRawInputData(HRAWINPUT(Msg.LParam),
 62         RID_HEADER, @ttagRAWINPUT, Size, sizeof(RAWINPUTHEADER))>0 then
 63    begin
 64      if (ttagRAWINPUT.header.dwType = RIM_TYPEKEYBOARD) then
 65      begin
 66        Size := ttagRAWINPUT.header.dwSize;
 67        if GetRawInputData (HRAWINPUT(Msg.LParam),
 68             RID_INPUT, @ttagRAWINPUT, Size, sizeOf(RAWINPUTHEADER))>= 0 then
 69        begin
 70          ttagRAWKEYBOARD.VKey     := ttagRAWINPUT.keyboard.VKey;
 71          ttagRAWKEYBOARD.Flags    := ttagRAWINPUT.keyboard.Flags;
 72          ttagRAWKEYBOARD.MakeCode := ttagRAWINPUT.keyboard.MakeCode;
 73          ttagRAWKEYBOARD.Message  := ttagRAWINPUT.keyboard.Message;
 74          KeyboardHandle           := ttagRAWINPUT.header.hDevice;
 75          ProcessKeyPressMessage(msg,ttagRAWKEYBOARD,KeyboardHandle);
 76         end;
 77      end;
 78    end;
 79
 80  end; //end  if   (msg.message=WM_INPUT) then
 81
 82  if assigned(FOldOnMessage) then FOldOnMessage( Msg,Handled);
 83end;
 84
 85
 86constructor TRawInputKeyboard.Create(AOwner: TComponent);
 87begin
 88  inherited Create(AOwner);;
 89  FOldOnMessage:=Application.OnMessage;
 90  Application.OnMessage:=ApplicationEventsMessage;
 91  RegisterRaw;
 92end;
 93
 94destructor TRawInputKeyboard.Destroy;
 95begin
 96  inherited;
 97end;
 98procedure TRawInputKeyboard.ProcessKeyPressMessage(var Msg: tagMSG;
 99  Keyboard: RAWKEYBOARD; KeyboardHandle: THANDLE);
begin
  case  Keyboard.Message of
    WM_KEYDOWN :    DoRawKeyDown(keyboard.VKey,KeyboardHandle);
    WM_KEYUP   :    DoRawKeyUp(Keyboard.VKey,KeyboardHandle);
  end;
end;
procedure TRawInputKeyboard.DoRawKeyDown(Key: Word;KeyboardHandle: THANDLE);
begin
  if assigned(FOnRawKeyDown) then
    FOnRawKeyDown(self,key,KeyboardHandle);
end;
procedure TRawInputKeyboard.DoRawKeyUp(Key: Word;KeyboardHandle: THANDLE);
begin
   if assigned(FOnRawKeyUp) then
    FOnRawKeyUp(self,key,KeyboardHandle);
end;
procedure TRawInputKeyboard.RegisterRaw;
var
  Size:   Cardinal;
  RRawIinputDevice: array[0..0] of RAWINPUTDEVICE;
begin
  RRawIinputDevice[0].usUsagePage := 1;
  RRawIinputDevice[0].usUsage     := 6;
  RRawIinputDevice[0].dwFlags  := RIDEV_CAPTUREMOUSE;
  RRawIinputDevice[0].hwndTarget := Application.Handle;
  Size:= sizeOf(RAWINPUTDEVICE);
  if  not (RegisterRawInputDevices(@RRawIinputDevice, 1, Size)) then
  begin
     raise Exception.Create('RegisterRawInputDevices error!');
  end
end;

end.

运行效果：