Delphi实现全局热键的方法以及实例

5bug 2018-01-04 39人围观 ,发现0个评论 全局热键GlobalAddAtomTHKModifiers

全局热键在WinForm桌面端软件里是经常会用到的,例如最常见的就是QQ的提取消息,截图等。所以我们在Delphi开发自己的软件的时候也基本上都要实现这个功能,这里给大家分享一个我自己封装的全局热键的类,具体封装代码如下:

unit uMyHotKey;

interface

uses Classes, Windows, Messages, Menus, SysUtils, Forms, ComCtrls;

type
  THotKeyItem = class
  public
    NotifyName: string;
    NotifyID: Integer;
    HotKey_Key: Word;
    HotKey_Shift: Word;
    AtomID: Atom;
  end;

  TOnExcuteEvent = procedure(Sender: TObject; NotifyID: Integer) of object;

  TMyHotKey = class(TComponent)
  private
    FHandle: HWND;
    FHotKeyList: TList;
    FOnExcuteEvent: TOnExcuteEvent;
    procedure ClearHotKeyList;
    function FindHotKeyItem(ANotifyID: Integer): THotKeyItem; overload;
    function FindHotKeyItem(AHotKey_Shift, AHotKey_Key: Word): THotKeyItem; overload;
    procedure SetOnExcuteEvent(const Value: TOnExcuteEvent);
    function GetHandle: THandle;
    property Handle: THandle read GetHandle;
  protected
    procedure HookProc(var Msg: TMessage); virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ExcuteHotKey(AHotKey_Shift, AHotKey_Key: Word);
    function RegMyHotKey(ANotifyID: Integer; ANotifyName: string; AShortCut: TShortCut): Boolean;
    function UpdateHotKey(ANotifyID: Integer; AShortCut: TShortCut): Boolean;
    property OnExcuteEvent: TOnExcuteEvent read FOnExcuteEvent write SetOnExcuteEvent;
  end;

function HotKeyToString(Value: Longint): string;

implementation

function ShiftStateToWord(Shift: TShiftState): Word;
begin
  if ssShift in Shift then
    Result := MOD_SHIFT
  else
    Result := 0;
  if ssCtrl in Shift then
    Result := Result or MOD_CONTROL;
  if ssAlt in Shift then
    Result := Result or MOD_ALT;
end;

function HotKeyToShortCut(Value: Longint): TShortCut;
var
  FModifiers: THKModifiers;
  FHotKey: Word;
begin
  FModifiers := THKModifiers(HiByte(Value));
  FHotKey := LoWord(LoByte(Value));
  Result := FHotKey;
  if hkShift in FModifiers then
    Inc(Result, scShift);
  if hkCtrl in FModifiers then
    Inc(Result, scCtrl);
  if hkAlt in FModifiers then
    Inc(Result, scAlt);
end;

function HotKeyToString(Value: Longint): string;
begin
  Result := ShortCutToText(HotKeyToShortCut(Value));
end;

{ TMyHotKey }

constructor TMyHotKey.Create(AOwner: TComponent);
begin
  FHotKeyList := TList.Create;
  inherited Create(AOwner);
  FHandle := AllocateHWnd(HookProc);
end;

destructor TMyHotKey.Destroy;
begin
  DeallocateHWnd(FHandle);
  ClearHotKeyList;
  FHotKeyList.Free;
  inherited;
end;

procedure TMyHotKey.HookProc(var Msg: TMessage);
begin
  if Msg.Msg = WM_HOTKEY then
    ExcuteHotKey(Msg.LParamLo, Msg.LParamHi);
end;

procedure TMyHotKey.ExcuteHotKey(AHotKey_Shift, AHotKey_Key: Word);
var
  AHotKeyItem: THotKeyItem;
begin
  AHotKeyItem := FindHotKeyItem(AHotKey_Shift, AHotKey_Key);
  if AHotKeyItem <> nil then
  begin
    if Assigned(FOnExcuteEvent) then
      FOnExcuteEvent(Self, AHotKeyItem.NotifyID);
  end;
end;

function TMyHotKey.RegMyHotKey(ANotifyID: Integer; ANotifyName: string; AShortCut: TShortCut): Boolean;
var
  AHotKey_Shift, AHotKey_Key: Word;
  AShiftState: TShiftState;
  AHotKeyItem: THotKeyItem;
  LHKModifiers: THKModifiers;
begin
  Result := True;
  AHotKey_Key := LoWord(LoByte(AShortCut));
  LHKModifiers := THKModifiers(HiByte(AShortCut));
  AShiftState := [];
  if hkShift in LHKModifiers then
    Include(AShiftState, ssShift);
  if hkCtrl in LHKModifiers then
    Include(AShiftState, ssCtrl);
  if hkAlt in LHKModifiers then
    Include(AShiftState, ssAlt);
  AHotKey_Shift := ShiftStateToWord(AShiftState);
  AHotKeyItem := FindHotKeyItem(ANotifyID);
  if AHotKeyItem = nil then
  begin
    AHotKeyItem := THotKeyItem.Create;
    AHotKeyItem.NotifyID := ANotifyID;
    AHotKeyItem.AtomID := GlobalAddAtom(PChar('#MYHOTKEY_' + IntToStr(ANotifyID)));
    FHotKeyList.Add(AHotKeyItem);
  end;
  UnRegisterHotKey(Handle, AHotKeyItem.AtomID);
  AHotKeyItem.NotifyName := ANotifyName;
  AHotKeyItem.HotKey_Key := AHotKey_Key;
  AHotKeyItem.HotKey_Shift := AHotKey_Shift;
  Result := RegisterHotKey(Handle, AHotKeyItem.AtomID, AHotKey_Shift, AHotKey_Key);
end;

function TMyHotKey.UpdateHotKey(ANotifyID: Integer; AShortCut: TShortCut): Boolean;
var
  AHotKey_Shift, AHotKey_Key: Word;
  AShiftState: TShiftState;
  AHotKeyItem: THotKeyItem;
  LHKModifiers: THKModifiers;
begin
  Result := True;
  AHotKey_Key := LoWord(LoByte(AShortCut));
  LHKModifiers := THKModifiers(HiByte(AShortCut));
  AShiftState := [];
  if hkShift in LHKModifiers then
    Include(AShiftState, ssShift);
  if hkCtrl in LHKModifiers then
    Include(AShiftState, ssCtrl);
  if hkAlt in LHKModifiers then
    Include(AShiftState, ssAlt);
  AHotKey_Shift := ShiftStateToWord(AShiftState);
  AHotKeyItem := FindHotKeyItem(ANotifyID);
  if AHotKeyItem <> nil then
  begin
    UnRegisterHotKey(Handle, AHotKeyItem.AtomID);
    AHotKeyItem.HotKey_Key := AHotKey_Key;
    AHotKeyItem.HotKey_Shift := AHotKey_Shift;
    RegisterHotKey(Handle, AHotKeyItem.AtomID, AHotKey_Shift, AHotKey_Key);
    Result := RegisterHotKey(Handle, AHotKeyItem.AtomID, AHotKey_Shift, AHotKey_Key);
  end
  else
    Result := RegMyHotKey(ANotifyID, '全局热键' + IntToStr(ANotifyID), AShortCut);
end;

procedure TMyHotKey.SetOnExcuteEvent(const Value: TOnExcuteEvent);
begin
  FOnExcuteEvent := Value;
end;

procedure TMyHotKey.ClearHotKeyList;
var
  I: Integer;
  AHotKeyItem: THotKeyItem;
begin
  for I := 0 to FHotKeyList.Count - 1 do
  begin
    AHotKeyItem := FHotKeyList.Items[I];
    UnRegisterHotKey(Handle, AHotKeyItem.AtomID);
    GlobalDeleteAtom(AHotKeyItem.AtomID);
    FreeAndNil(AHotKeyItem);
  end;
  FHotKeyList.Clear;
end;

function TMyHotKey.FindHotKeyItem(ANotifyID: Integer): THotKeyItem;
var
  I: Integer;
  AHotKeyItem: THotKeyItem;
begin
  Result := nil;
  for I := 0 to FHotKeyList.Count - 1 do
  begin
    AHotKeyItem := FHotKeyList.Items[I];
    if AHotKeyItem.NotifyID = ANotifyID then
    begin
      Result := AHotKeyItem;
      Break;
    end;
  end;
end;

function TMyHotKey.FindHotKeyItem(AHotKey_Shift, AHotKey_Key: Word): THotKeyItem;
var
  I: Integer;
  AHotKeyItem: THotKeyItem;
begin
  Result := nil;
  for I := 0 to FHotKeyList.Count - 1 do
  begin
    AHotKeyItem := FHotKeyList.Items[I];
    if (AHotKeyItem.HotKey_Shift = AHotKey_Shift) and (AHotKeyItem.HotKey_Key = AHotKey_Key) then
    begin
      Result := AHotKeyItem;
      Break;
    end;
  end;
end;

function TMyHotKey.GetHandle: THandle;
begin
  Result := FHandle;
end;

end.

热键管理类如下:

unit uHotKeyManager;

interface

uses System.Classes, uXGDataList, uMyHotKey, Vcl.Forms, Vcl.Menus;

const
  V_HotKey_ShowMsg = 10001;
  V_HotKey_CutScreen = 10002;

type
  THotKeyManager = class
  private
    FHotKey: TMyHotKey;
    procedure DoExcuteEvent(Sender: TObject; NotifyID: Integer);
  public
    constructor Create();
    destructor Destroy; override;
    procedure RegisterDefaultHotKeys;
    procedure UpdateHotKey(ANotifyID: Integer; AShortCut: TShortCut);
  end;

implementation

{ THotKeyManager }

constructor THotKeyManager.Create;
begin
  FHotKey := TMyHotKey.Create(Vcl.Forms.Application);
  FHotKey.OnExcuteEvent := DoExcuteEvent;
end;

destructor THotKeyManager.Destroy;
begin
  inherited;
end;

procedure THotKeyManager.DoExcuteEvent(Sender: TObject; NotifyID: Integer);
begin
  case NotifyID of
    V_HotKey_ShowMsg: ;
    V_HotKey_CutScreen:;
  end;
end;

procedure THotKeyManager.RegisterDefaultHotKeys;
begin
  FHotKey.RegMyHotKey(V_HotKey_ShowMsg, '提取消息', TextToShortCut('Ctrl+Alt+Z'));
  FHotKey.RegMyHotKey(V_HotKey_CutScreen, '屏幕截图', TextToShortCut('Ctrl+Alt+A'));
end;

procedure THotKeyManager.UpdateHotKey(ANotifyID: Integer; AShortCut: TShortCut);
begin
  FHotKey.UpdateHotKey(ANotifyID, AShortCut);
end;

end.

程序里使用THotKeyManager类就可以了,可以更换默认热键,也可以添加修改对应的热键,基本算是满足要求了。

请扫码加入QQ群
微信二维码
不容错过
Powered By Z-BlogPHP