Delphi Windows热键注册管理类

简单的代码实现了一份Windows热键注册，允许对注册的热键进行命名管理，如果你想跨平台实现则只需要实现IHotKeyObject接口即可。

unit HotKeyUnit;

interface
uses
  Winapi.Windows,System.SysUtils,System.Generics.Collections;

type
  THotKey = class;
  THotKeyEvent = procedure (Sender: TObject; fsModifiers,valKey: Word) of object;



  IHotKeyObject = interface
    function RegisterHotKey(hWnd: HWND; lpString: LPCSTR; fsModifiers, vk: UINT): BOOL;
    function UnregisterHotKey(hWnd: HWND; lpString: LPCSTR): BOOL;
  end;

{ THotKeyObject }

  THotKeyObject = class(TInterfacedObject, IHotKeyObject)
  public
    function RegisterHotKey(hWnd: HWND; lpString: LPCSTR; fsModifiers, vk: UINT): BOOL;virtual;
    function UnregisterHotKey(hWnd: HWND; lpString: LPCSTR): BOOL;virtual;
  end;

{ THotKeyInWindows }

  THotKeyInWindows = class(THotKeyObject)
  public
    function RegisterHotKey(hWnd: HWND; lpString: LPCSTR; fsModifiers, vk: UINT): BOOL;override;
    function UnregisterHotKey(hWnd: HWND; lpString: LPCSTR): BOOL;override;
  end;

{ THotKeyItem }

  THotKeyItem = class(TObject)
  private

  protected
    _HotKey:IHotKeyObject;
    _Sender:THotKey;
    _Name:LPCSTR;
    _hWnd: HWND;
    _fsModifiers: UINT;
    _vk: UINT;
    _Result:Boolean;
    _CallBack:THotKeyEvent;
  public
    /// <summary>
    /// 快捷键名称
    /// </summary>
    property HotKeyName:LPCSTR read _name;
    /// <summary>
    /// 按键
    /// </summary>
    property Key:UINT read _vk;
    /// <summary>
    /// 控制键
    /// </summary>
    property Modifiers:UINT read _fsModifiers;
    /// <summary>
    /// 热键绑定的窗口句柄
    /// </summary>
    property FromHandle:HWND read _hWnd;
    constructor Create(Sender: THotKey;hWnd: HWND;Name:LPCSTR;fsModifiers,vk: UINT);
    /// <summary>
    /// 热键注册是否成功
    /// </summary>
    property IsSuccess:Boolean read _Result;
    /// <summary>
    /// 热键绑定事件
    /// </summary>
    property HotKeyEvent:THotKeyEvent read _CallBack write _CallBack;
    destructor Destroy; override;
  end;


{ THotKey }

  THotKey = class(TObject)
  private

  protected
    _NameHash:TDictionary<LPCSTR,THotKeyItem>;
    function QueryItem(fsModifiers,vk: UINT):THotKeyItem;
    function AddNameHash(hWnd: HWND;Name:LPCSTR;fsModifiers,vk: UINT;CallBack:THotKeyEvent):Boolean;
  public
    /// <summary>
    /// 热键事件
    /// </summary>
    /// <param name="fsModifiers"></param>
    /// <param name="valKey"></param>
    /// <remarks>
    /// 请在WM_HOTKEY事件中调用！
    /// </remarks>
    procedure MessageEvent(fsModifiers,valKey: Word);
    /// <summary>
    /// 添加热键
    /// </summary>
    /// <param name="hWnd">窗口句柄</param>
    /// <param name="lpString">热键名称</param>
    /// <param name="fsModifiers">控制键</param>
    /// <param name="vk">按键</param>
    /// <param name="CallBack">热键回调</param>
    /// <returns>是否成功</returns>
    function AddHotKey(hWnd: HWND; lpString: LPCSTR; fsModifiers, vk: UINT;CallBack:THotKeyEvent):Boolean;
    /// <summary>
    /// 移除热键
    /// </summary>
    /// <param name="hWnd">窗口句柄</param>
    /// <param name="lpString">热键名称</param>
    procedure RemoveHotKey(hWnd: HWND; lpString: LPCSTR);
    constructor Create;
    destructor Destroy; override;
  end;



implementation


{ THotKeyInWindows }

function THotKeyInWindows.RegisterHotKey(hWnd: HWND; lpString: LPCSTR; fsModifiers,vk: UINT): BOOL;
var
  mHostKey:Integer;
begin
  mHostKey := GlobalAddAtomA(lpString) - $C000;
  Result := Winapi.Windows.RegisterHotKey(hWnd,mHostKey,fsModifiers,vk);
end;

function THotKeyInWindows.UnregisterHotKey(hWnd: HWND; lpString: LPCSTR): BOOL;
var
  mHostKey:Integer;
begin
   mHostKey := GlobalFindAtomA(lpString) - $C000;
   Result := Winapi.Windows.UnRegisterHotKey(hWnd,mHostKey);
   GlobalDeleteAtom(mHostKey);
end;

{ THotKeyObject }

function THotKeyObject.RegisterHotKey(hWnd: HWND; lpString: LPCSTR; fsModifiers,vk: UINT): BOOL;
begin
  Result := FALSE;
end;

function THotKeyObject.UnregisterHotKey(hWnd: HWND; lpString: LPCSTR): BOOL;
begin
  Result := False;
end;

{ THotKey }

function THotKey.AddHotKey(hWnd: HWND; lpString: LPCSTR; fsModifiers,
  vk: UINT;CallBack:THotKeyEvent): Boolean;
begin
  Result := AddNameHash(hWnd,lpString,fsModifiers,vk,CallBack);
end;

function THotKey.AddNameHash(hWnd: HWND; Name: LPCSTR; fsModifiers,
  vk: UINT;CallBack:THotKeyEvent): Boolean;
var
  Value:THotKeyItem;
begin
  Value := THotKeyItem.Create(Self,hWnd,Name,fsModifiers,vk);
  Value.HotKeyEvent := CallBack;

  if Value.IsSuccess then
   _NameHash.Add(Name,Value);

  Result := Value.IsSuccess;
end;

constructor THotKey.Create;
begin
  _NameHash := TDictionary<LPCSTR,THotKeyItem>.Create;
end;

destructor THotKey.Destroy;
var
  arrays:TArray<THotKeyItem>;
  aitem:THotKeyItem;
begin
  arrays := _NameHash.Values.ToArray;
  for aitem IN arrays do
  begin
    aitem.Free;
  end;
  _NameHash.Free;
  inherited;
end;

procedure THotKey.MessageEvent(fsModifiers,valKey: Word);
var
  aitem:THotKeyItem;
begin
  aitem := QueryItem(fsModifiers,valKey);
  if aitem <> nil then
  begin
    if Assigned(aitem.HotKeyEvent) then
      aitem.HotKeyEvent(Self,fsModifiers,valKey);
  end;
end;

function THotKey.QueryItem(fsModifiers, vk: UINT): THotKeyItem;
var
  arrays:TArray<THotKeyItem>;
  aitem:THotKeyItem;
begin
  Result := nil;
  arrays := _NameHash.Values.ToArray;
  for aitem IN arrays do
  begin
   if (aitem._fsModifiers = fsModifiers) and (aitem._vk = vk) then
   begin
     Result := aitem;
     exit;
   end;
  end;
end;

procedure THotKey.RemoveHotKey(hWnd: HWND; lpString: LPCSTR);
var
  aitem:THotKeyItem;
begin
  if _NameHash.ContainsKey(lpString) then
    _NameHash.Items[lpString].Free;
end;

{ THotKeyItem }

constructor THotKeyItem.Create(Sender: THotKey;hWnd: HWND;Name:LPCSTR;fsModifiers,vk: UINT);
begin
  _Sender := Sender;
  _HotKey := THotKeyInWindows.Create;
  _hWnd := hWnd;
  _Name := Name;
  _fsModifiers := fsModifiers;
  _vk := vk;
  _Result := _HotKey.RegisterHotKey(hWnd,Name,fsModifiers,vk);
end;

destructor THotKeyItem.Destroy;
begin
  _HotKey.UnregisterHotKey(_hwnd,_Name);
  _HotKey := nil;
  inherited;
end;

end.