type
EFailedRegisterHotkey =
class(
Exception);
EAlreadyExists =
class(
Exception);
THotkeyEvent =
procedure (ID : Integer)
of object;
THotkeySet =
record
Hotkey : TShortcut;
Init : Boolean;
ID : Word;
end;
THotKeyFrontEnd =
class(TObject)
private
FHandle : THandle;
FHotkeys :
array of THotkeySet;
FOnHotkey: THotkeyEvent;
function GetHotkeys(
index: Integer): THotkeySet;
procedure ShortCutToHotKey(HotKey: TShortCut;
var Key : Word;
var Modifiers: Cardinal);
public
property Hotkeys[
index : Integer] : THotkeySet
read GetHotkeys;
property OnHotkey : THotkeyEvent
read FOnHotkey
write FOnHotkey;
procedure RegisterHotkey(AHotkey : TShortCut);
procedure ChangeHotkey(
index : Integer; ANewHotkey : TShortCut);
function HotkeysCount : Integer;
procedure WMHotKey(
var Msg: TWMHotKey);
message WM_HOTKEY;
constructor Create(AHandle : THandle);
destructor Destroy;
override;
end;
implementation
{ THotKeyFrontEnd }
procedure THotKeyFrontEnd.ShortCutToHotKey(HotKey: TShortCut;
var Key : Word;
var Modifiers: Cardinal);
var
Shift: TShiftState;
begin
ShortCutToKey(HotKey, Key, Shift);
Modifiers := 0;
if (ssShift
in Shift)
then
Modifiers := Modifiers
or MOD_SHIFT;
if (ssAlt
in Shift)
then
Modifiers := Modifiers
or MOD_ALT;
if (ssCtrl
in Shift)
then
Modifiers := Modifiers
or MOD_CONTROL;
end;
procedure THotKeyFrontEnd.WMHotKey(
var Msg: TWMHotKey);
var
i : Integer;
begin
for i := 0
to High(FHotkeys)
do
begin
if Msg.Msg = FHotkeys[i].ID
then
begin
if Assigned(FOnHotkey)
then
FOnHotkey(i);
end;
end;
end;
procedure THotKeyFrontEnd.ChangeHotkey(
index: Integer; ANewHotkey: TShortCut);
var
key : Word;
Modifiers : Cardinal;
b : THotkeySet;
begin
if (
index >= 0)
and (
index < Length(FHotkeys))
then
begin
b := FHotkeys[
index];
if b.Hotkey <> ANewHotkey
then
begin
b.Hotkey := ANewHotkey;
if b.init
then begin
UnRegisterHotKey(FHandle, b.ID);
GlobalDeleteAtom(b.ID);
end;
ShortCutToHotKey(ANewHotkey, Key, Modifiers);
b.ID := GlobalAddAtom(PChar('
hk' + IntToStr(
index)));
if not Windows.RegisterHotKey(FHandle, b.ID, Modifiers, Key)
then begin
b.init := false;
raise EFailedRegisterHotkey.CreateFmt(FAILED_REGISTER_HOTKEY, [ShortCutToText(ANewHotkey)]);
end else
b.init := true;
end else
raise EAlreadyExists.CreateFmt(ALREADY_EXISTS, [ShortCutToText(ANewHotkey)]);
end;
end;
constructor THotKeyFrontEnd.Create(AHandle: THandle);
begin
inherited Create;
FHandle := AHandle;
end;
destructor THotKeyFrontEnd.Destroy;
var
i : Word;
begin
for i := 1
to High(FHotkeys)
do
begin
if FHotkeys[i].init
then begin
UnRegisterHotKey(FHandle, FHotkeys[i].ID);
GlobalDeleteAtom(FHotkeys[i].ID);
end;
end;
inherited;
end;
function THotKeyFrontEnd.GetHotkeys(
index: Integer): THotkeySet;
begin
Result := FHotkeys[
index];
end;
function THotKeyFrontEnd.HotkeysCount: Integer;
begin
Result := Length(FHotkeys);
end;
procedure THotKeyFrontEnd.RegisterHotkey(AHotkey: TShortCut);
var
i : Integer;
key : Word;
Modifiers : Cardinal;
b : THotkeySet;
begin
for i := 1
to High(FHotkeys)
do begin
if FHotkeys[i].Hotkey = AHotkey
then
begin
raise EAlreadyExists.CreateFmt(ALREADY_EXISTS, [ShortCutToText(AHotkey)]);
end;
end;
SetLength(FHotkeys, Length(FHotkeys) + 1);
b := FHotkeys[High(FHotkeys)];
b.Hotkey := AHotkey;
ShortCutToHotKey(AHotkey, Key, Modifiers);
b.ID := GlobalAddAtom(PChar('
hk' + IntToStr(Length(FHotkeys))));
if not Windows.RegisterHotKey(FHandle, b.ID, Modifiers, Key)
then begin
b.init := false;
raise EFailedRegisterHotkey.CreateFmt(FAILED_REGISTER_HOTKEY, [ShortCutToText(AHotkey)]);
end else
b.init := true;
end;