D7全局热键

一个简单的Delphi7全局热键

unit uHotKey;

interface

uses
  Windows, SysUtils, Messages, Classes;

const
  VK_0=$30;  //0键
  VK_1=$31;  //1键
  VK_2=$32;  //2键
  VK_3=$33;  //3键
  VK_4=$34;  //4键
  VK_5=$35;  //5键
  VK_6=$36;  //6键
  VK_7=$37;  //7键
  VK_8=$38;  //8键
  VK_9=$39;  //9键
  VK_A=$41;  //A键
  VK_B=$42;  //B键
  VK_C=$43;  //C键
  VK_D=$44;  //D键
  VK_E=$45;  //E键
  VK_F=$46;  //F键
  VK_G=$47;  //G键
  VK_H=$48;  //H键
  VK_I=$49;  //I键
  VK_J=$4A;  //J键
  VK_K=$4B;  //K键
  VK_L=$4C;  //L键
  VK_M=$4D;  //M键
  VK_N=$4E;  //N键
  VK_O=$4F;  //O键
  VK_P=$50;  //P键
  VK_Q=$51;  //Q键
  VK_R=$52;  //R键
  VK_S=$53;  //S键
  VK_T=$54;  //T键
  VK_U=$55;  //U键
  VK_V=$56;  //V键
  VK_W=$57;  //W键
  VK_X=$58;  //X键
  VK_Y=$59;  //Y键
  VK_Z=$5A;  //Z键

type
  THotKey = class
  private
    FName:PAnsiChar;
    FHandle:THandle;
    FAtom:ATOM;
    FfsModifiers:UINT;
    Fvk:UINT;
    FEnable:Boolean;
  public
    constructor Create(AName:string;AHandle:THandle;fsModifiers,vk:UINT);
    destructor Destroy; override;
    property Atom:ATOM read FAtom;
    property fsModifiers:UINT read FfsModifiers;
    property vk:UINT read Fvk;
    property Enable:Boolean read FEnable;
    function IsThis(msg:TMessage):Boolean;
  end;

  THotKeyEvent = procedure(hotkey_index:Integer;msg:TMessage) of object;
  THotKeyMaster = class(TStringList) 
  private
    FName:string;
    FHandle:THandle;
    FHotKeyEvent:THotKeyEvent;

    function skey(fsModifiers,vk:UINT):string;
  protected
    procedure WndProc(var msg:TMessage);
  public
    constructor Create(AName:string);overload;
    destructor Destroy; override;
    function RegisterHotKey(fsModifiers,vk:UINT):Boolean;
    procedure UnRegisterHotKey(fsModifiers,vk:UINT);
  published
    property OnHotKeyEvent:THotKeyEvent read FHotKeyEvent write FHotKeyEvent;
  end;

implementation

constructor THotKey.Create(AName:string;AHandle:THandle;fsModifiers,vk:UINT);
begin
  inherited Create;
  FName:=PAnsiChar(AName);  
  FHandle:=AHandle;
  if FindAtom(FName)=0 then
    FAtom:=GlobalAddAtom(FName)
  else
    FAtom:=GlobalFindAtom(FName);
  FfsModifiers:=fsModifiers;
  Fvk:=vk;
  FEnable:=RegisterHotKey(FHandle,FAtom,FfsModifiers,vk);
end;

destructor THotKey.Destroy;
begin
  UnregisterHotKey(FHandle,FAtom);
  GlobalDeleteAtom(FAtom);
  inherited Destroy;
end;

function THotKey.IsThis(msg:TMessage):Boolean;
begin
  Result:=(msg.WParam=FAtom) and (msg.LParamLo=FfsModifiers) and (msg.LParamHi=Fvk);
end;

constructor THotKeyMaster.Create(AName:string);
begin
  inherited Create;
  FName:=AName;
  FHandle:=Classes.AllocateHWnd(WndProc);
end;

destructor THotKeyMaster.Destroy;
var
  i:Integer;
begin
  for i:=Count-1 downto 0 do
    THotKey(Objects[i]).Destroy;
  inherited Destroy;
end;

function THotKeyMaster.skey(fsModifiers,vk:UINT):string;
begin
  Result:=IntToHex(fsModifiers,2)+IntToHex(vk,2);
end;

procedure THotKeyMaster.WndProc(var msg:TMessage);
var
  i,index:Integer;
begin
  index:=-1;
  for i:=0 to Count-1 do
  if THotKey(Objects[i]).IsThis(msg) then
  begin
    index:=i;
    Break;
  end;
  if (index>-1) and Assigned(FHotKeyEvent) then
  begin
    FHotKeyEvent(i,msg);
  end
  else
    DefWindowProc(FHandle,msg.Msg,msg.WParam,msg.LParam)
end;

function THotKeyMaster.RegisterHotKey(fsModifiers,vk:UINT):Boolean;
var
  key:string; 
  index:Integer;
  HotKey:THotKey;
begin
  key:=skey(fsModifiers,vk);
  index:=IndexOf(key);
  if index>-1 then
    Result:=False
  else
  begin
    HotKey:=THotKey.Create(PAnsiChar(FName+IntToStr(Count)),FHandle,fsModifiers,vk);
    Result:=HotKey.Enable;
    if Result then
      AddObject(key,HotKey)
    else
      HotKey.Destroy;
  end;
end;

procedure THotKeyMaster.UnRegisterHotKey(fsModifiers,vk:UINT);
var
  key:string;
  index:Integer;
begin
  key:=skey(fsModifiers,vk);
  index:=IndexOf(key);
  if index>-1 then
  begin
    THotKey(Objects[index]).Destroy;
    Delete(index);
  end;
end;

end.

使用方法

unit uMain;

interface

uses
  uHotKey,
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TfrmMain = class(TForm)
    Memo1: TMemo;
    Label1: TLabel;
    ComboBox1: TComboBox;
    ComboBox2: TComboBox;
    Edit1: TEdit;
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Edit1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
    HotKeyMaster:THotKeyMaster;
    procedure hotkey(hotkey_index:Integer;msg:TMessage);
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  HotKeyMaster:=THotKeyMaster.Create('testhotkey');
  HotKeyMaster.OnHotKeyEvent:=hotkey;
  HotKeyMaster.RegisterHotKey(0, VK_1);                          //数字1
  HotKeyMaster.RegisterHotKey(0, VK_2);                          //数字2
  HotKeyMaster.RegisterHotKey(0, VK_3);                          //数字3    
  HotKeyMaster.RegisterHotKey(0, VK_A);                          //字母A
  HotKeyMaster.RegisterHotKey(0, VK_NUMPAD0);                    //数字键盘0
  HotKeyMaster.RegisterHotKey(0, VK_NUMPAD1);                    //数字键盘1
  HotKeyMaster.RegisterHotKey(0, VK_NUMPAD2);                    //数字键盘2
  HotKeyMaster.RegisterHotKey(MOD_ALT, ord('1'));                //ALT+1
  HotKeyMaster.RegisterHotKey(MOD_CONTROL + MOD_ALT, ord('1'));  //CTRL+ALT+1
end;

procedure TfrmMain.hotkey(hotkey_index:Integer;msg:TMessage);
begin
  {case hotkey_index of
    0:ShowMessage('1');
    1:ShowMessage('2');
    2:ShowMessage('3');
    3:ShowMessage('A');
    4:ShowMessage('NUM0'); 
    5:ShowMessage('NUM1');
    6:ShowMessage('NUM2');
    7:ShowMessage('ALT+1');   
    8:ShowMessage('CTRL+ALT+1');
  end;}
  Memo1.Lines.Add('按键：'+IntToStr(hotkey_index)+', 值：'+IntToStr(msg.LParamLo)+', '+IntToStr(msg.LParamHi));
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  HotKeyMaster.Destroy;
end;

procedure TfrmMain.Button1Click(Sender: TObject);
var
  key:Char;
begin       
  if Edit1.Text='' then Exit;
  key:=Edit1.Text[1];
  HotKeyMaster.RegisterHotKey(ComboBox1.ItemIndex*2+ComboBox2.ItemIndex*2, ord(key));  //CTRL+ALT+1
end;

procedure TfrmMain.Button2Click(Sender: TObject);
var
  key:Char;
begin
  if Edit1.Text='' then Exit;
  key:=Edit1.Text[1];
  HotKeyMaster.UnRegisterHotKey(ComboBox1.ItemIndex*2+ComboBox2.ItemIndex*2, ord(key));  //CTRL+ALT+1
end;

procedure TfrmMain.Edit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  Edit1.Text:='';
end;

end.