hotkeyspy.pas

热键控件DELPHI开发程序用到的控件希望对你有帮助

{**********************************************************}
{                                                          }
{  THotKeySpy Component Version 1.01                       }
{                                                          }
{  Function: Spy keyboard event when application running.  }
{                                                          }
{  HotKeySpy is a modificatory edition for AMHotKey        }
{  component( Author: Alexander Meeder ). I think          }
{  something is not good in AMHotKey, so I Modified it.    }
{                                                          }
{  If you make cool changes to it, please send them to me. }                                
{                                                          }
{  Email: [e-mail]                                    }
{  URL: http://haoxg.yeah.net                              }
{                                                          }
{**********************************************************}

unit HotKeySpy;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics,
  Controls, Forms, Dialogs;

type
  THotKeySpy = class;

  TWMHotKey = record
    Msg: Cardinal;
    idHotKey: Word;
    Modifiers: Integer;
    VirtKey : Integer;
  end;

  TModifier = (moShift, moControl, moAlt, moWin);
  TModifiers = set of TModifier;

  TVirtKey = (vkNone, vkCancel, vkBack, vkTab, vkClear, vkReturn, vkPause, vkCapital, vkEscape,
              vkSpace, vkPrior, vkNext, vkEnd, vkHome, vkLeft, vkUp, vkRight, vkDown,
              vkSelect, vkExecute, vkSnapshot, vkInsert, vkDelete, vkHelp,
              vk0, vk1, vk2, vk3, vk4, vk5, vk6, vk7, vk8, vk9,
              vkA, vkB, vkC, vkD, vkE, vkF, vkG, vkH, vkI, vkJ, vkK, vkL, vkM,
              vkN, vkO, vkP, vkQ, vkR, vkS, vkT, vkU, vkV, vkW, vkX, vkY, vkZ,
              vkNumpad0, vkNumpad1, vkNumpad2, vkNumpad3, vkNumpad4,
              vkNumpad5, vkNumpad6, vkNumpad7, vkNumpad8, vkNumpad9,
              vkMultiply, vkAdd, vkSeparator, vkSubtract, vkDecimal, vkDivide,
              vkF1, vkF2, vkF3, vkF4, vkF5, vkF6, vkF7, vkF8, vkF9, vkF10, vkF11, vkF12,
              vkF13, vkF14, vkF15, vkF16, vkF17, vkF18, vkF19, vkF20, vkF21, vkF22, vkF23, vkF24,
              vkNumlock, vkScroll, vkApps);

  THotKeyEvent = procedure(Sender: TObject; HotKeyIndex: Word) of object;

  THotKeyItem = class(TCollectionItem)
  private
    FEnabled: boolean;
    FModifiers: TModifiers;
    FRegistered: Boolean;
    FVirtKey: TVirtKey;
    FOnHotKey: TNotifyEvent;

    procedure SetEnabled(Value: Boolean);
    procedure SetModifiers(Value: TModifiers);
    procedure SetVirtKey(Value: TVirtkey);
    function GetVirtKey: TVirtKey;

    procedure RegisterHK;
    procedure UnregisterHK;
    procedure ReRegisterHK;
  protected
    function GetDisplayName: string; override;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;

    property Registered: Boolean read FRegistered Default false;
    function GetHotKeyName: string;
  published
    property Enabled: boolean read FEnabled write SetEnabled;
    property Modifiers: TModifiers read FModifiers write SetModifiers;
    property VirtKey: TVirtKey read GetVirtKey write SetVirtKey default vkNone;
    property OnHotKey: TNotifyEvent read FOnHotKey write FOnHotKey;
  end;

  THotKeys = class(TCollection)
  private
    FHotKeySpy: THotKeySpy;
    
    function GetItem(Index: Integer): THotKeyItem;
    procedure SetItem(Index: Integer; Value: THotKeyItem);
  protected
    function GetOwner: TPersistent; override;
  public
    constructor Create(AHotKeySpy: THotKeySpy);
    destructor Destroy; override;

    function Add: THotKeyItem;
    property HotKeys[Index: Integer]: THotKeyItem read GetItem write SetItem; default;
  end;

  THotKeySpy = class(TComponent)
  private
    FHotKeys: THotKeys;
    FWindowHandle: HWnd;
    FOnHotKeyEvents: THotKeyEvent;

    procedure SetHotKeys(Value: THotKeys);
    procedure WndProc(var Msg: TMessage);
  protected
    procedure Loaded; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    function ShortCutToVirtKey(Value: TShortCut): TVirtKey;
    function VirtKeyToShortCut(Value: TVirtKey): TShortCut;
    procedure SetAllEnabled;
    procedure SetAllDisabled;
  published
    property HotKeys: THotKeys read FHotKeys write SetHotKeys;
    property OnHotKeys: THotKeyEvent read FOnHotKeyEvents write FOnHotKeyEvents;
  end;

procedure Register;

implementation

var
  VirtKeys : array[TVirtKey] of UInt =
             ($00, $03, $08, $09, $0C, $0D, $13, $14, $1B,
              $20, $21, $22, $23, $24, $25, $26, $27, $28,
              $29, $2B, $2C, $2D, $2E, $2F,
              $30, $31, $32, $33, $34, $35, $36, $37, $38, $39,
              $41, $42, $43, $44, $45, $46, $47, $48, $49, $4A,
              $4B, $4C, $4D, $4E, $4F, $50, $51, $52, $53, $54,
              $55, $56, $57, $58, $59, $5A,
              $60, $61, $62, $63, $64, $65, $66, $67, $68, $69,
              $6A, $6B, $6C, $6D, $6E, $6F,
              $70, $71, $72, $73, $74, $75, $76, $77, $78, $79, $7A, $7B,
              $7C, $7D, $7E, $7F, $80, $81, $82, $83, $84, $85, $86, $87,
              $90, $91, $5D);

  VirtKeyStr : array[TVirtKey] of string =
             ('None', 'Cancel', 'Back', 'Tab', 'Clear', 'Return', 'Pause', 'Capital', 'Escape',
              'Space', 'Prior', 'Next', 'End', 'Home', 'Left', 'Up', 'Right', 'Down',
              'Select', 'Execute', 'Snapshot', 'Insert', 'Delete', 'Help',
              '0', '1', '2', '3', '4', '5', '6', '7', '8', '9',
              'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M',
              'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z',
              'Numpad0', 'Numpad1', 'Numpad2', 'Numpad3', 'Numpad4',
              'Numpad5', 'Numpad6', 'Numpad7', 'Numpad8', 'Numpad9',
              'Multiply', 'Add', 'Separator', 'Subtract', 'Decimal', 'Divide',
              'F1', 'F2', 'F3', 'F4', 'F5', 'F6', 'F7', 'F8', 'F9', 'F10', 'F11', 'F12',
              'F13', 'F14', 'F15', 'F16', 'F17', 'F18', 'F19', 'F20', 'F21', 'F22', 'F23', 'F24',
              'Numlock', 'Scroll', 'Apps');


procedure Register;
begin
  RegisterComponents('DayDream', [THotKeySpy]);
end;

{ THotKeySpy }

constructor THotKeySpy.Create(AOwner: TComponent);
var
  I: integer;
begin
  for I := 0 to AOwner.ComponentCount - 1 do
    if AOwner.Components[I] is THotKeySpy then
      raise Exception.Create('No more than one THotKeySpy-component on a form');

  if (AOwner =  nil) or not (AOwner is TForm) then
    raise Exception.Create('The owner of THotKeySpy must be a form');

  inherited Create(AOwner);
  FHotKeys := THotKeys.Create(Self);

  FWindowHandle := AllocateHWnd(WndProc);
end;

destructor THotKeySpy.Destroy;
begin
  FHotKeys.Free;
  DeallocateHWnd(FWindowHandle);
  inherited Destroy;
end;

procedure THotKeySpy.SetAllEnabled;
var
  I: integer;
begin
  for I := 0 to HotKeys.Count - 1 do
    HotKeys[I].Enabled := true;
end;

procedure THotKeySpy.SetAllDisabled;
var
  I: integer;
begin
  for I := 0 to HotKeys.Count - 1 do
    HotKeys[I].Enabled := false;
end;

procedure THotKeySpy.SetHotKeys(Value: THotKeys);
begin
  FHotKeys.Assign(Value);
end;

procedure THotKeySpy.WndProc(var Msg: TMessage);
begin
  if (Owner as TWinControl) = nil then exit;

  if Msg.Msg = WM_HOTKEY then
  begin
    with TWMHotKey(Msg) do
    begin
      if Assigned(HotKeys[idHotKey].FOnHotKey) then HotKeys[idHotKey].FOnHotKey(Self);
      if Assigned(FOnHotKeyEvents) then FOnHotKeyEvents(Self, idHotKey);
    end;
  end else
    Msg.Result := DefWindowProc(FWindowHandle, Msg.Msg, Msg.wParam, Msg.lParam);
end;

procedure THotKeySpy.Loaded;
var
  I: integer;
begin
  if not (csDesigning in ComponentState) then
    for I := 0 to HotKeys.Count - 1 do
      if HotKeys[I].Enabled then HotKeys[I].RegisterHK;
end;

function THotKeySpy.ShortCutToVirtKey(Value: TShortCut): TVirtKey;
var
  i: Uint;
begin
  for i := 0 to UInt(High(VirtKeys)) do
    if Value = VirtKeys[TVirtKey(i)] then
    begin
      Result := TVirtKey(i);
      exit;
    end;
  Result := vkNone;
end;

function THotKeySpy.VirtKeyToShortCut(Value: TVirtKey): TShortCut;
begin
  Result := TShortCut(VirtKeys[Value]);
end;

{ THotKeys }

constructor THotKeys.Create(AHotKeySpy: THotKeySpy);
begin
  inherited Create(THotKeyItem);
  FHotKeySpy := AHotKeySpy;
end;

destructor THotKeys.Destroy;
begin
  inherited Destroy;
end;

function THotKeys.GetItem(Index: Integer): THotKeyItem;
begin
  Result := THotKeyItem(inherited GetItem(Index));
end;

procedure THotKeys.SetItem(Index: Integer; Value: THotKeyItem);
begin
  inherited SetItem(Index, Value);
end;

function THotKeys.GetOwner: TPersistent;
begin
  Result := FHotKeySpy;
end;

function THotKeys.Add: THotKeyItem;
begin
  Result := THotKeyItem(inherited Add);
end;

{ THotKeyItem }

constructor THotKeyItem.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FEnabled := True;
  FRegistered := False;
  FVirtKey := vkNone;
end;

destructor THotKeyItem.Destroy;
begin
  SetEnabled(false);
  inherited Destroy;
end;

procedure THotKeyItem.SetEnabled(Value: boolean);
begin
  if (Value <> FEnabled) then
  begin
    FEnabled := Value;

    if not (csDesigning in THotKeySpy(THotKeys(GetOwner).GetOwner).ComponentState) then
      if FEnabled then
        RegisterHK
      else
        UnregisterHK;
  end;
end;

procedure THotKeyItem.SetModifiers(Value: TModifiers);
begin
  if Value <> FModifiers then
  begin
    FModifiers := Value;
    ReRegisterHK;
  end;
end;

procedure THotKeyItem.SetVirtKey(Value: TVirtKey);
begin
  if Value <> FVirtKey then
  begin
    FVirtKey := Value;
    if Value = vkNone then Enabled := False;
    ReRegisterHK;
  end;
end;

function THotKeyItem.GetVirtKey: TVirtKey;
begin
  Result := FVirtKey;
end;

function THotKeyItem.GetDisplayName: string;
begin
  Result := '';
  if moShift    in Modifiers then Result := Result + 'Shift';
  if moControl  in Modifiers then Result := Result + 'Control';
  if moAlt      in Modifiers then Result := Result + 'Alt';
  if moWin      in Modifiers then Result := Result + 'Win';
  if Result = '' then
    Result := VirtKeyStr[VirtKey]
  else
    Result := Result + '_' + VirtKeyStr[VirtKey];

  if Result = '' then Result := inherited GetDisplayName;
end;

function THotKeyItem.GetHotKeyName: string;
begin
  Result := GetDisplayName;
end;

procedure THotKeyItem.Assign(Source: TPersistent);
begin
  if Source is THotKeyItem then
  begin
    Enabled := THotKeyItem(Source).Enabled;
    Modifiers := THotKeyItem(Source).Modifiers;
    VirtKey := THotKeyItem(Source).VirtKey;
    Exit;
  end;
  inherited Assign(Source);
end;

procedure THotKeyItem.RegisterHK;

  function ModToFlag(Modifiers : TModifiers): UInt;
  begin
    Result := 0;
    if moShift    in Modifiers then Result := Result or MOD_SHIFT;
    if moControl  in Modifiers then Result := Result or MOD_CONTROL;
    if moAlt      in Modifiers then Result := Result or MOD_ALT;
    if moWin      in Modifiers then Result := Result or MOD_WIN;
  end;

begin
  FRegistered := False;
  if (VirtKey <> vkNone) then
    FRegistered := RegisterHotKey(THotKeySpy(THotKeys(GetOwner).GetOwner).FWindowHandle,
                                  Index, ModToFlag(Modifiers), VirtKeys[FVirtKey]);
end;

procedure THotKeyItem.UnregisterHK;
begin
  if FRegistered then
    FRegistered := not UnregisterHotKey(THotKeySpy(THotKeys(GetOwner).GetOwner).FWindowHandle, Index);
end;

procedure THotKeyItem.ReRegisterHK;
begin
  if not (csDesigning in THotKeySpy(THotKeys(GetOwner).GetOwner).ComponentState) then
    if FEnabled then
    begin
      if FRegistered then UnregisterHK;
      RegisterHK;
    end;
end;

end.