delphi 按键测试

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Imaging.pngimage, Vcl.ExtCtrls,
  Vcl.StdCtrls, Vcl.Buttons, Vcl.ComCtrls, Vcl.DBCtrls, System.StrUtils;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDblClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
    procedure Remote(key: Integer);
  public
    { Public declarations }
    procedure WndProc(var Message: TMessage); override;
    procedure MyCopyData(var message: TWMCopyData); message WM_COPYDATA;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure SendMyKeyDown(key: Integer);
var
  data: TCopyDataStruct;
  str: string;
begin
  str:= '下'+ IntToStr(key);
  data.dwData := 0;
  data.cbData := Length(str) + 1;
  data.lpData := PChar(str);
  SendMessage(Application.MainForm.Handle, WM_COPYDATA, 0, LongWord(@data));
end;

procedure SendMyKeyUp(key: Integer);
var
  data: TCopyDataStruct;
  str: string;
begin
  str:= '上'+ IntToStr(key);
  data.dwData := 0;
  data.cbData := Length(str) + 1;
  data.lpData := PChar(str);
  SendMessage(Application.MainForm.Handle, WM_COPYDATA, 0, LongWord(@data));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Button1.Visible := False;
  Button2.Visible := False;
  Button3.Visible := False;
  Button4.Visible := False;

  SendMyKeyDown(Ord('A'));
  SendMyKeyUp(Ord('A'));
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Button1.Visible := False;
  Button2.Visible := False;
  Button3.Visible := False;
  Button4.Visible := False;

  SendMyKeyDown(VK_CONTROL);
  SendMyKeyUp(VK_CONTROL);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  Button1.Visible := False;
  Button2.Visible := False;
  Button3.Visible := False;
  Button4.Visible := False;

  SendMyKeyDown(VK_SHIFT);
  SendMyKeyUp(VK_SHIFT);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  Button1.Visible := False;
  Button2.Visible := False;
  Button3.Visible := False;
  Button4.Visible := False;

  SendMyKeyDown(VK_MENU);
  SendMyKeyUp(VK_MENU);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  self.KeyPreview := True;
end;

procedure TForm1.FormDblClick(Sender: TObject);
begin
  Label1.Caption := '';
  Label2.Caption := '';
  Label3.Caption := '';
  Label4.Caption := '';


  Button1.Visible := not Button1.Visible;
  Button2.Visible := not Button2.Visible;
  Button3.Visible := not Button3.Visible;
  Button4.Visible := not Button4.Visible;
end;

procedure TForm1.MyCopyData(var message: TWMCopyData);
var
  data: PCopyDataStruct;
  str: string;
  key: Integer;
begin
  data := message.CopyDataStruct;
  str := string(PChar(data.lpData));
  if StartsText('下', str) then
  begin
    key := StrToInt(StringReplace(str, '下', '', []));
    keybd_event(key, MapVirtualKey(key, 0), 0, 0);
  end
  else
  begin
    key := StrToInt(StringReplace(str, '上', '', []));
    keybd_event(key, MapVirtualKey(key, 0), KEYEVENTF_KEYUP, 0);
  end;
end;

procedure TForm1.Remote(key: Integer);
begin
  //这里就是接收到的按键
end;

procedure TForm1.WndProc(var Message: TMessage);
begin
  inherited;

  case Message.Msg of
    WM_KEYDOWN:
      begin
        Label1.Caption := Format('KeyDown: %d - %d', [message.WParam, message.LParam]);
        Remote(message.WParam);
      end;
    WM_KEYUP:
      begin
        Label2.Caption := Format('KeyUp: %d - %d', [message.WParam, message.LParam]);
        Remote(message.WParam);
      end;
    WM_SYSKEYDOWN:
      begin
        Label3.Caption := Format('SysKeyDown: %d - %d', [message.WParam, message.LParam]);
        Remote(message.WParam);
      end;
    WM_SYSKEYUP:
      begin
        Label4.Caption := Format('SysKeyUp: %d - %d', [message.WParam, message.LParam]);
        Remote(message.WParam);
      end;
  end;
end;

end.