Einzelnen Beitrag anzeigen

Benutzerbild von xZise
xZise

Registriert seit: 3. Mär 2006
Ort: Waldbronn
4.303 Beiträge
 
Delphi 2009 Professional
 
#1

Hotkeyunit - Message auslagern

  Alt 26. Apr 2007, 18:12
Ich habe eine Objekt dami ich einfach Hotkeys erstellen kann. Nur werden die Hotkeys nicht erfasst... Wie könnte ich sozusagen die Messages des Mutterprogramms abfragen?
Delphi-Quellcode:
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;
Fabian
Eigentlich hat MS Windows ab Vista den Hang zur Selbstzerstörung abgewöhnt – mkinzler
  Mit Zitat antworten Zitat