我试试看，等着
====
好了
library PHotkey;
{ Important note about DLL memory management: ShareMem must be the
first unit in your library's USES clause AND your project's (select
Project-View Source) USES clause if your DLL exports any procedures or
functions that pass strings as parameters or function results. This
applies to all strings passed to and from your DLL--even those that
are nested in records and classes. ShareMem is the interface unit to
the BORLNDMM.DLL shared memory manager, which must be deployed along
with your DLL. To avoid using BORLNDMM.DLL, pass string information
using PChar or ShortString parameters. }
uses
SysUtils,
Classes,
DllHotKey in 'DllHotKey.pas';
{$R *.res}
exports
SetHotKey,
UnHotKey;
begin
unit DllHotKey;
interface
uses
Windows, SysUtils, Classes, Menus;
procedure SetHotKey(ShortCut: PAnsiChar; const HotHwnd: HWND = 0); stdcaLL;
procedure UnHotKey(); stdcaLL;
implementation
const
Atom_Name = 'HHmianatom';
Class_Name = 'HHMainName';
var
HotKey: string;
ATom: TATOM;
HHMain: THandle;
Wnc: TWndClass;
hWnc: THandle;
OldMethod: Pointer = nil;
function showMessage(Msg: string; Flag: UINT = MB_OK): Integer;
begin
Result := Windows.messageBox(Windows.GetForegroundWindow, PChar(Msg), 'DllHotKey', Flag);
end;
function WindProc(H: HWND; Msg: UINT; wParam, lParam: Integer): LRESULT; stdcall;
begin
if (wParam <> 0) and (wParam = ATom) then
begin
ShowMessage(HotKey);
end;
if OldMethod <> nil then {不安全的方法}
Result := CallWindowProc(OldMethod, H, Msg, wParam, lParam)
else
Result := Windows.DefWindowProc(H, Msg, wParam, lParam);
end;
procedure SetHotKey(ShortCut: PAnsiChar; const HotHwnd: HWND = 0);
var
AShortCut: TShortCut;
Key: Word;
Shift: TShiftState;
Vk, fsModifiers: UINT;
begin
HotKey := ShortCut;
AShortCut := TextToShortCut(HotKey);
ShortCutToKey(AShortCut, Key, Shift);
VK := Key;
fsModifiers := 0;
if ssCTRL in Shift then fsModifiers := MOD_CONTROL;
if ssALT in Shift then fsModifiers := fsModifiers or MOD_CONTROL;
if ssSHIFT in Shift then fsModifiers := fsModifiers or MOD_SHIFT;
///if then fsModifiers := fsModifiers or MOD_WIN;
if HotHwnd = 0 then
begin
Wnc.style := windows.CS_VREDRAW;
wnc.hInstance := hInstance;
wnc.lpfnWndProc := @WindProc;
wnc.lpszClassName := Class_Name;
hWnc := Windows.RegisterClass(Wnc);
if hWnc <> 0 then
begin
HHMain := Windows.CreateWindowEx(WS_EX_OVERLAPPEDWINDOW,
Class_Name, Class_Name, windows.WS_OVERLAPPEDWINDOW, 0, 0, 0, 0, 0, 0, hInstance, nil);
if HHMain = 0 then
showMessage('注册窗口失败.');
end else showMessage('注册窗口类失败.')
end
else begin
HHMain := HotHwnd;
OldMethod := Pointer(Windows.GetWindowLong(HHMain, windows.GWL_WNDPROC));
if OldMethod <> nil then
Windows.SetWindowLong(HHMain, GWL_WNDPROC, Integer(@WindProc));
end;
if HHMain <> 0 then
begin
ATom := Windows.AddAtom(Atom_Name);
if not Windows.RegisterHotKey(HHMain, ATom, fsModifiers, vk) then
showMessage('注册热键失败.')
end;
end;
procedure UnHotKey;
begin
if (HHMain <> 0) and (ATom <> 0) then
begin
Windows.UnregisterHotKey(HHMain, ATom);
Windows.DestroyWindow(HHMain);
HHMain := 0;
ATom := 0;
end;
if hWnc <> 0 then
Windows.UnregisterClass(Class_Name, hInstance);
end;
end.
调用的地方
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Menus;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
MainMenu1: TMainMenu;
PopupMenu1: TPopupMenu;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
procedure SetHotKey(ShortCut: PAnsiChar; const HotHwnd: HWND = 0); stdcaLL; external 'PHotkey.dll';
procedure UnHotKey(); stdcall; external 'PHotkey.dll';
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
SetHotKey('CTRL+SHIFT+F4', Handle);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
UnHotKey
end;
end.
]