{*******************************************************}
{                                                       }
{       TFormHotKeyHandler                              }
{                                                       }
{*******************************************************}

unit HKHandler;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, ComCtrls, Menus, Clipbrd;

type
  TFormHotKeyHandler = class(TCustomControl)
  private
    fKeyRegistered: Boolean;
    fActive: Boolean;
    fIdString: String;
    fHotKey: TShortCut;
    fOnBeforeAction: TNotifyEvent;
    fOnAction: TNotifyEvent;
    fOnAfterAction: TNotifyEvent;
    procedure SetActive(Value: Boolean);
    procedure UpdatefHotKey(Value: TShortCut);
  protected
    procedure loaded; override;
    procedure WndProc(var Message: TMessage); override;
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    procedure   StartAction;
  published
    property Active: Boolean read fActive write SetActive;
    property IdString: String read fIdString write fIdString;
    property KeyRegistered: Boolean read fKeyRegistered write fKeyRegistered;
    property HotKey: TShortCut read fHotKey write UpdatefHotKey;
    property OnBeforeAction: TNotifyEvent read fOnBeforeAction write fOnBeforeAction;
    property OnAction: TNotifyEvent read fOnAction write fOnAction;
    property OnAfterAction: TNotifyEvent read fOnAfterAction write fOnAfterAction;
  end;

procedure Register;

implementation

var Old: TShortCut;

constructor TFormHotKeyHandler.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fKeyRegistered := False;
  fActive := False;
  fHotKey := TextToShortCut('');
  Visible := false;
  height := 28;
  width := 28;
end;

procedure TFormHotKeyHandler.SetActive(Value: Boolean);
begin
     fActive := Value;
end;

procedure TFormHotKeyHandler.Paint;
var
   PaintRect: TRect;
   Bmp: TBitmap;
   ResName : array[0..20] of char;
begin
   if (csDesigning in ComponentState) then
   begin
        PaintRect := Rect(0, 0, 28, 28);
        Frame3D(Canvas, PaintRect, clBtnHighlight, clBtnShadow, 1);
        Bmp := TBitmap.create;
        StrPCopy(ResName,classname);
        Bmp.handle := LoadBitmap(hinstance,ResName);
        BitBlt(canvas.handle, 2, 2, ClientRect.Right-4, ClientRect.Bottom-4, Bmp.canvas.handle, 0, 0, SRCCOPY);
        Bmp.free;
   end;
end;

destructor TFormHotKeyHandler.Destroy;
begin
  inherited Destroy;
end;

procedure TFormHotKeyHandler.UpdatefHotKey(Value: TShortCut);
begin
  if not (csDesigning in ComponentState) then
   begin
    if fKeyRegistered then
     if (not UnregisterHotKey(handle,IDHOT_SNAPWINDOW)) and (ShortCutToText(fHotKey)<>'') then
      begin
       fKeyRegistered := False;
       Application.MessageBox(PChar('Unable to unregister '+fIdString+' hotkey "'+ShortCutToText(fHotKey)+'".'+#13#13+
       'Another application may have locked it.  Try closing all other applications.'),'Hotkey Error',MB_OK+MB_ICONERROR);
      end
     else
      begin
       Old := fHotKey;
       fHotKey := Value;
       Loaded;
       { Key was not registered }
       if not fKeyRegistered then
        Loaded;
      end
    else
     if ShortCutToText(Value)<>'' then
      begin
       fHotKey := Value;
       Loaded;
      end
   end;
end;

procedure TFormHotKeyHandler.loaded;
var Shift: TShiftState;
    Key: Word;
    fsModifiers: Cardinal;
begin
  if not (csDesigning in ComponentState) then
  if (ShortCutToText(fHotKey)<>'') then
  begin
   ShortCutToKey(fHotKey,Key,Shift);
   fsModifiers := Cardinal(nil);
   if ssCtrl in Shift then
    fsModifiers := fsModifiers + MOD_CONTROL;
   if ssAlt in Shift then
    fsModifiers := fsModifiers + MOD_ALT;
   if ssShift in Shift then
    fsModifiers := fsModifiers + MOD_SHIFT;
   fKeyRegistered := True;
   if (not RegisterHotkey(handle, IDHOT_SNAPWINDOW, fsModifiers{MOD_ALT}, Key{VK_F12})) then
    begin
      fKeyRegistered := False;
      Application.MessageBox(PChar('Unable to register '+fIdString+' hotkey "'+ShortCutToText(fHotKey)+'".  It may be locked '+
      'by another application.'+#13#13+
      'Try changing the hotkey or closing all other applications.'),'Hotkey Error',MB_OK+MB_ICONERROR);
      fHotKey := Old;
    end;
  end;
end;

procedure TFormHotKeyHandler.WndProc(var Message: TMessage);
begin
    if (Message.Msg = WM_HOTKEY) and (Message.wParam = IDHOT_SNAPWINDOW) and fActive then
     StartAction;
    inherited WndProc(Message);
end;

procedure TFormHotKeyHandler.StartAction;
begin
  if (assigned(fOnBeforeAction)) then fOnBeforeAction(self);
  if (assigned(fOnAction)) then fOnAction(self);
  if (assigned(fOnAfterAction)) then fOnAfterAction(self);
end;

procedure Register;
begin
  RegisterComponents('My Components', [TFormHotKeyHandler]);
end;

end.
