Componentes.Terceros.jvcl/official/3.32/run/JvAppHotKey.pas

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvHotKey.PAS, released on 2002-05-26.

The Initial Developer of the Original Code is Peter Thörnqvist [peter3 at sourceforge dot net]
Portions created by Peter Thörnqvist are Copyright (C) 2002 Peter Thörnqvist.
All Rights Reserved.

Contributor(s):

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Description:
  A component that allows the user to register an application wide hotkey combination.
  Set the HotKey property to a *unique* combination of Ctrl,Alt,Shift and a character.
  Set active to True to receive notifications when the hotkey is pressed. The OnHotKey
  event is called when the user presses the hotkey combination.
  
30/03/2006 Added property WinModifier. Windows key will now be recognized.

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvAppHotKey.pas 11057 2006-11-29 14:32:05Z marquardt $

unit JvAppHotKey;

{$I jvcl.inc}
{$I windowsonly.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Windows, Messages, Classes,
  JvComponentBase;

type
  TJvHotKeyRegisterFailed = procedure(Sender: TObject; var HotKey: TShortCut) of object;

  TJvApplicationHotKey = class(TJvComponent)
  protected
    FActive: Boolean;
    FHotKey: TShortCut;
    FOnHotKey: TNotifyEvent;
    FHandle: THandle;
    FID: Integer;
    FHasRegistered: Boolean;
    FOnHotKeyRegisterFailed: TJvHotKeyRegisterFailed;
    FWindowsKey : Boolean;
    
    procedure SetActive(Value: Boolean);
    procedure SetHotKey(Value: TShortCut);
    function WndProc(var Msg: TMessage): Boolean;
    procedure GetWndProc;
    procedure ResetWndProc;
  protected
    procedure DoHotKey; virtual;
    function DoRegisterHotKey: Boolean; dynamic;

    procedure SetWindowsKey(Value : Boolean);
  public
    destructor Destroy; override;
  published
    property Active: Boolean read FActive write SetActive default False;
    property HotKey: TShortCut read FHotKey write SetHotKey;

    // If True, the Windows Key must be pressed for the shortcut to trigger
    property WindowsKey: Boolean read FWindowsKey write SetWindowsKey default False;

    property OnHotKey: TNotifyEvent read FOnHotKey write FOnHotKey;
    property OnHotKeyRegisterFailed: TJvHotKeyRegisterFailed
      read FOnHotKeyRegisterFailed write FOnHotKeyRegisterFailed;
  end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/tags/JVCL3_32/run/JvAppHotKey.pas $';
    Revision: '$Revision: 11057 $';
    Date: '$Date: 2006-11-29 15:32:05 +0100 (mer., 29 nov. 2006) $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  Controls, Menus,
  JvWndProcHook;

var
  HotKeyInstances: Integer = 0;

procedure GetHotKey(AShortCut: TShortCut; var VirtKey, Modifiers: Word);
var
  Shift: TShiftState;
begin
  ShortCutToKey(AShortCut, VirtKey, Shift);
  Modifiers := 0;
  if ssCtrl in Shift then
    Modifiers := Modifiers or MOD_CONTROL;
  if ssShift in Shift then
    Modifiers := Modifiers or MOD_SHIFT;
  if ssAlt in Shift then
    Modifiers := Modifiers or MOD_ALT;
end;


//=== { TJvApplicationHotKey } ===============================================

destructor TJvApplicationHotKey.Destroy;
begin
  ResetWndProc;
  inherited Destroy;
end;

procedure TJvApplicationHotKey.SetHotKey(Value: TShortCut);
var
  B: Boolean;
begin
  if FHotKey <> Value then
  begin
    B := FActive;
    SetActive(False);
    FHotKey := Value;
    SetActive(B);
  end;
end;

procedure TJvApplicationHotKey.SetWindowsKey(Value : Boolean);
begin
  FWindowsKey := Value;
  If Active then
  begin
    Active := False;
    Active := True;
  end;
end;

function TJvApplicationHotKey.DoRegisterHotKey: Boolean;
var
  AShortCut: TShortCut;
  VirtKey, Mods: Word;
begin
  Result := False;
  if FHandle = 0 then
  begin
    FHandle := TWinControl(Owner).Handle;
    GetHotKey(FHotKey, VirtKey, Mods);

    if WindowsKey then
      Mods := Mods or MOD_WIN;

    while not RegisterHotKey(FHandle, FID, Mods, VirtKey) do
    begin
      if Assigned(FOnHotKeyRegisterFailed) then
      begin
        AShortCut := FHotKey;
        FOnHotKeyRegisterFailed(Self, FHotKey);
        // make sure we don't get stuck in a loop here:
        if AShortCut = FHotKey then
          Exit;
        GetHotKey(FHotKey, VirtKey, Mods);
      end
      else
        Exit;
    end;
    Result := True;
  end;
end;

procedure TJvApplicationHotKey.SetActive(Value: Boolean);
begin
  if FActive <> Value then
  begin
    if csDesigning in ComponentState then
    begin
      FActive := Value;
      Exit;
    end;
    if Value and not FHasRegistered then
    begin
      if IsLibrary then
        FID := GlobalAddAtom(PChar(ParamStr(0)))
      else
      begin
        FID := HotKeyInstances;
        Inc(HotKeyInstances);
      end;
      if not DoRegisterHotKey then
        Exit;
      GetWndProc;
    end
    else
    if FHasRegistered then
    begin
      UnRegisterHotKey(FHandle, FID);
      ResetWndProc;
      if IsLibrary then
        GlobalDeleteAtom(FID);
    end;
    FActive := Value;
  end;
end;

procedure TJvApplicationHotKey.DoHotKey;
begin
  if Assigned(FOnHotKey) then
    FOnHotKey(Self);
end;

procedure TJvApplicationHotKey.GetWndProc;
begin
  if not FHasRegistered and (Owner is TWinControl) then
  begin
    RegisterWndProcHook(TWinControl(Owner), WndProc, hoAfterMsg);
    FHasRegistered := True;
  end
  else
    SetActive(False);
end;

procedure TJvApplicationHotKey.ResetWndProc;
begin
  if FHasRegistered and (Owner is TWinControl) then
  begin
    UnregisterWndProcHook(TWinControl(Owner), WndProc, hoAfterMsg);
    FHasRegistered := False;
  end;
  FHandle := 0;
end;

function TJvApplicationHotKey.WndProc(var Msg: TMessage): Boolean;
begin
  if (Msg.Msg = WM_HOTKEY) and (FID = Msg.WParam) then
    DoHotKey;
  Result := False;
end;

{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.