用THotKey控件设置全局热键

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ComCtrls;

type
  TForm1 = class(TForm)
    BitBtn1: TBitBtn;
    HotKey1: THotKey;
    procedure BitBtn1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
        procedure wmhotkey(var Msg: TMessage); message WM_HOTKEY;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
   Key, Shift: Word; { TODO : 热键 }
implementation

{$R *.dfm}
function   ShiftStateToWord(Shift:TShiftState):Word;
begin
  Result:= 0;   // 重要,网上的别的代码这儿没设置
    if   ssShift   in   Shift   then     Result   :=MOD_SHIFT;
    if   ssCtrl   in   Shift   then   Result   :=Result   or   MOD_CONTROL;
    if   ssAlt   in   Shift   then   Result:=Result   or   MOD_ALT;
end;

procedure ShortCutToKey(ShortCut: TShortCut; var Key: Word; var Shift: TShiftState);
begin
  Key := ShortCut and not (scShift + scCtrl + scAlt);
  Shift := [];
  if ShortCut and scShift <> 0 then Include(Shift, ssShift);
  if ShortCut and scCtrl <> 0 then Include(Shift, ssCtrl);
  if ShortCut and scAlt <> 0 then Include(Shift, ssAlt);
end;


procedure TForm1.BitBtn1Click(Sender: TObject);
var
  T: TShiftState;
begin
  ShortCutToKey(HotKey1.HotKey, Key, T);
  Shift := ShiftStateToWord(T);
  RegisterHotKey(Handle, GlobalAddAtom('MyHotKey') - $C000, Shift, Key);
end;

procedure TForm1.wmhotkey(var Msg: TMessage);
begin
  if (Msg.LparamLo = Shift) and (Msg.LParamHi = Key) then
    ShowMessage('OK ');

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  RegisterHotKey(Handle, GlobalAddAtom('hotkey'), MOD_WIN, VK_SPACE); //space

end;

end.

posted @ 2011-11-08 11:58  翔飞  阅读(281)  评论(0编辑  收藏  举报