hotkeymanager.pas

热键管理控件源代码

  end;

  function IterateVKNames(KeyName: String): Word;
  var
    I: Integer;
    K: Word;
  begin
    K := 0;
    for I := $08 to $FF do        // The brute force approach
      if AnsiCompareText(KeyName, HotKeyToText(I, Localized)) = 0 then
      begin
        K := I;
        Break;
      end;
    Result := K;
  end;

  function GetKeyValue: Word;
  var
    K: Word;
    KeyName: String;
    C: Char;
  begin
    K := 0;
    if Tokens.Count > 0 then
    begin
      KeyName := Trim(Tokens[Tokens.Count-1]);
      if Length(KeyName) = 1 then
      begin
        C := UpCase(KeyName[1]);
        case Byte(C) of
          $30..$39, $41..$5A:     // 0..9, A..Z
            K := Ord(C);
        else
          K := IterateVKNames(C);
        end;
      end
      else
      begin
        if KeyName = 'Num' then   // Special handling for 'Num +'
          KeyName := KeyName + ' +';
        if (KeyName <> ModName_Ctrl) and (KeyName <> LocalModName_Ctrl) and
           (KeyName <> ModName_Alt) and (KeyName <> LocalModName_Alt) and
           (KeyName <> ModName_Shift) and (KeyName <> LocalModName_Shift) and
           (KeyName <> ModName_Win) and (KeyName <> LocalModName_Win) then
        K := IterateVKNames(KeyName);
      end;
    end;
    Result := K;
  end;

var
  Modifiers, Key: Word;
begin
  Tokens := TStringList.Create;
  try
    ExtractStrings(['+'], [' '], PChar(Text), Tokens);
    Modifiers := GetModifiersValue;
    if (Modifiers = 0) and (Tokens.Count > 1) then
      // Something went wrong when translating the modifiers
      Result := 0
    else
    begin
      Key := GetKeyValue;
      if Key = 0 then
        // Something went wrong when translating the key
        Result := 0
      else
        Result := GetHotKey(Modifiers, Key);
    end;
  finally
    Tokens.Free;
  end;
end;

{------------------- THotKeyManager -------------------}

constructor THotKeyManager.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  HotKeyList := TList.Create;

  if not (csDesigning in ComponentState) then
  begin
    // Create a virtual window with a callback method and use it as handle
{$IFDEF DELPHI_6_UP}
    FHandle := Classes.AllocateHWnd(HookProc);
{$ELSE}
    FHandle := AllocateHWnd(HookProc);
{$ENDIF}
  end;
end;


destructor THotKeyManager.Destroy;
begin
  ClearHotKeys;
  HotKeyList.Free;

  if not (csDesigning in ComponentState) then
  begin
    // Destroy our virtual window
{$IFDEF DELPHI_6_UP}
    Classes.DeallocateHWnd(FHandle);
{$ELSE}
    DeallocateHWnd(FHandle);
{$ENDIF}
  end;

  inherited Destroy;
end;


function THotKeyManager.AddHotKey(HotKey: Cardinal): Word;
var
  hkr: PHotKeyRegistration;
  Modifiers, Key: Word;
  Atom: Word;
begin
  SeparateHotKey(HotKey, Modifiers, Key);
  // Create unique id (global atom)
  Atom := GlobalAddAtom(PChar(HotKeyAtomPrefix + IntToStr(HotKey)));
  // Register
  if RegisterHotKey(FHandle, Atom, Modifiers, Key) then
  begin
    hkr := New(PHotKeyRegistration);
    hkr.HotKey := HotKey;
    hkr.KeyIndex := Atom;
    HotKeyList.Add(hkr);
    Result := Atom;
  end
  else
  begin
    GlobalDeleteAtom(Atom);
    Result := 0;
  end;
end;


function THotKeyManager.ChangeHotKey(Index: Word; NewHotKey: Cardinal): Word;
var
  I: Integer;
  hkr: PHotKeyRegistration;
begin
  Result := 0;
  for I := 0 to HotKeyList.Count -1 do
  begin
    hkr := PHotKeyRegistration(HotKeyList[I]);
    if hkr.KeyIndex = Index then
    begin
      RemoveHotKeyByIndex(hkr.KeyIndex);
      Result := AddHotKey(NewHotKey);
      Exit;
    end;
  end;
end;


function THotKeyManager.RemoveHotKey(HotKey: Cardinal): Boolean;
var
  I: Integer;
  hkr: PHotKeyRegistration;
begin
  Result := False;
  for I := 0 to HotKeyList.Count -1 do
  begin
    hkr := PHotKeyRegistration(HotKeyList[I]);
    if hkr.HotKey = TShortCut(HotKey) then
    begin
      Result := DisposeHotKey(hkr);
      HotKeyList.Remove(hkr);
      Exit;
    end;
  end;
end;


function THotKeyManager.RemoveHotKeyByIndex(Index: Word): Boolean;
var
  I: Integer;
  hkr: PHotKeyRegistration;
begin
  Result := False;
  for I := 0 to HotKeyList.Count -1 do
  begin
    hkr := PHotKeyRegistration(HotKeyList[I]);
    if hkr.KeyIndex = Index then
    begin
      Result := DisposeHotKey(hkr);
      HotKeyList.Remove(hkr);
      Exit;
    end;
  end;
end;


function THotKeyManager.HotKeyValid(HotKey: Cardinal): Boolean;
// Test if HotKey is valid (test if it can be registered even if this app. already registered it)
var
  M, K: Word;
  WasRegistered: Boolean;
  Atom: Word;
begin
  Atom := GlobalAddAtom(PChar(HotKeyAtomPrefix + IntToStr(HotKey)));
  SeparateHotKey(HotKey, M, K);
  WasRegistered := UnregisterHotKey(FHandle, Atom);
  if WasRegistered then
  begin
    RegisterHotKey(FHandle, Atom, M, K);
    Result := True;
  end
  else
  begin
    Result := RegisterHotKey(FHandle, Atom, M, K);
    if Result then
      UnregisterHotKey(FHandle, Atom);
  end;
  GlobalDeleteAtom(Atom);
end;


procedure THotKeyManager.ClearHotKeys;
var
  I: Integer;
  hkr: PHotKeyRegistration;
begin
  for I := HotKeyList.Count -1 downto 0 do
  begin
    hkr := PHotKeyRegistration(HotKeyList[I]);
    DisposeHotKey(hkr);
    HotKeyList.Remove(hkr);
  end;
end;


function THotKeyManager.DisposeHotKey(hkr: PHotKeyRegistration): Boolean;
begin
  // Unregister using previously assigned id (global atom)
  Result := UnregisterHotKey(FHandle, hkr.KeyIndex);
  GlobalDeleteAtom(hkr.KeyIndex);
  if Result then
    Dispose(hkr);
end;


procedure THotKeyManager.HookProc(var Msg: TMessage);

  function HotKeyFound(HotKey: Cardinal): Boolean;
  var
    I: Integer;
  begin
    Result := False;
    for I := 0 to HotKeyList.Count -1 do
      if PHotKeyRegistration(HotKeyList[I]).HotKey = HotKey then
      begin
        Result := True;
        Break;
      end;
  end;

var
  Modifier: Cardinal;
begin
  case Msg.Msg of
    WM_HOTKEY:
      if Assigned(FOnHotKeyPressed) then
      begin
        // Get modifier keys status
        Modifier := 0;
        if (Msg.LParamLo and MOD_SHIFT) <> 0 then
          Inc(Modifier, $2000);        // scShift
        if (Msg.LParamLo and MOD_CONTROL) <> 0 then
          Inc(Modifier, $4000);        // scCtrl
        if (Msg.LParamLo and MOD_ALT) <> 0 then
          Inc(Modifier, $8000);        // scAlt
        if (Msg.LParamLo and MOD_WIN) <> 0 then
          Inc(Modifier, $10000);
        { Check if the hotkey is in the list (it's possible user has registered hotkeys
          without using this component and handles these hotkeys by himself). }
        if HotKeyFound(Msg.LParamHi + Modifier) then
          OnHotKeyPressed(Msg.LParamHi + Modifier, Msg.WParam);
      end;
  end;

  // Pass the message on
  Msg.Result := DefWindowProc(FHandle, Msg.Msg, Msg.wParam, Msg.lParam);
end;


function IsUpperCase(S: String): Boolean;
var
  I: Integer;
  C: Byte;
begin
  Result := True;
  for I := 1 to Length(S) do
  begin
    C := Ord(S[I]);
    if (C < $41) or (C > $5A) then
    begin
      Result := False;
      Exit;
    end;
  end;
end;


procedure Register;
begin
  RegisterComponents('System', [THotKeyManager]);
end;


var
  Layouts: Cardinal;
//  kllist: array of HKL;
  kllist: array[0..100] of HKL;
  I: Integer;

initialization
  // Get localized names of modfiers
  LocalModName_Shift := HotKeyToText($10, True);
  LocalModName_Ctrl := HotKeyToText($11, True);
  LocalModName_Alt := HotKeyToText($12, True);
  if IsUpperCase(LocalModName_Alt) then
    LocalModName_Win := UpperCase(LocalModName_Win);

  { To get the non-localized (English) names of keys and modifiers we must load
    and activate the US English keyboard layout. However, we shouldn't change the
    user's current list of layouts, so the English layout should be unloaded
    after it is used (in HotKeyToText) in case it wasn't originally part of the
    user's list of layouts. It's a bit of a hack, but it's the only way I can
    think of to get the English names. }

  // Get all keyboard layouts
//  Layouts := GetKeyboardLayoutList(0, kllist);
//  SetLength(kllist, Layouts);
  Layouts := GetKeyboardLayoutList(100, kllist);

  // Load (but don't activate) US English keyboard layout for use in HotKeyToText
  EnglishKeyboardLayout := LoadKeyboardLayout(PChar('00000409'), KLF_NOTELLSHELL);

  // Examine if US English layout is already in user's list of keyboard layouts
  ShouldUnloadEnglishKeyboardLayout := True;
  for I := 0 to Layouts -1 do
  begin
    if kllist[I] = EnglishKeyboardLayout then
    begin
      ShouldUnloadEnglishKeyboardLayout := False;
      Exit;
    end;
  end;

finalization
  if ShouldUnloadEnglishKeyboardLayout then
    UnloadKeyboardLayout(EnglishKeyboardLayout);   // Restore prev. kbd. layout

end.