自定义事件（300）(300分)

我想通过函数自定义一个事件 捕获当前窗体的按键信息
1 必须自定义事件
2 只捕获当前窗体的

捕获当前窗体的消息不就行了.

具体怎样捕获 谁能给个例子

只能用钩子来做
{******************************************************************************}
{ }
{ 这是一个截获全局消息的组件 }
{ }
{ This is a component for capturing global message }
{ }
{******************************************************************************}


{************************************************}
{ }
{ 它可以截获键盘与鼠标事件，并可以得到触发事件 }
{ 的来源句柄、来源所在的进程...以及其他一些信息 }
{ }
{ It can capture keyboard event and mouse event, }
{ and can capture source handle from causeing }
{ event , process of source...and other }
{ information }
{ }
{************************************************}
unit SysHook;

interface

uses
Windows, Messages, SysUtils, Classes,TlHelp32;

type
{截获消息的结构 the structure of message}
TEventMsg = ^_EventMsg;
_EventMsg = packed record
Message : UINT;
ParamL : UINT;
ParamH : UINT;
Time : DWORD;
Hwnd : HWND;
end;

TMouseButton = (mbLeft, mbRight, mbMiddle);

TGetMessageEvent =
procedure (Msg : TEventMsg) of object;

TGetKeyDownMessage =
procedure (Key : Word;Winhandle :HWND) of object;

TGetKeyUpMessage =
procedure (Key : Word;Winhandle :HWND) of object;

TGetMouseDownMessage =
procedure (Button : TMouseButton;
WinHandle :HWND;X, Y : integer) of object;

TGetMouseUpMessage =
procedure (Button : TMouseButton;
WinHandle :HWND;X, Y : integer) of object;

TGetMouseMoveMessage =
procedure (X, Y : integer) of object;

TSysHook = class(TComponent)
private
FHooking: boolean;
Handle : HHOOK;
FOnGetMessage : TGetMessageEvent;
FOnKeyDown: TGetKeyDownMessage;
FOnKeyUp: TGetKeyUpMessage;
FOnMouseDown: TGetMouseDownMessage;
FOnMouseUp: TGetMouseupMessage;
FOnMouseMove: TGetMouseMoveMessage;
procedure SetHooking(const Value: boolean);
protected
procedure DoKeyDown(Msg : TEventMsg);dynamic;
procedure DoKeyUp(Msg : TEventMsg);dynamic;
procedure DoMouseDown(Msg : TEventMsg);dynamic;
procedure DoMouseUp(Msg : TEventMsg);dynamic;
procedure DoMouseMove(Msg : TEventMsg);dynamic;
public
constructor Create(AOwner : TComponent);override;
destructor Destroy;override;
function GetProcessInfo(AProcessID : DWORD)ProcessEntry32;
function GetWinClassName(WinHandle : HWND):string;
function GetProcess(WinHandle : HWND)WORD;
function GetInstance(WinHandle : HWND)WORD;
published
property Enabled : boolean
read FHooking write SetHooking;
property OnGetMessage : TGetMessageEvent
read FOnGetMessage write FOnGetMessage;
property OnKeyDown : TGetKeyDownMessage
read FOnKeyDown write FOnKeyDown;
property OnKeyUp : TGetKeyUpMessage
read FOnKeyUp write FOnKeyUp;
property OnMouseDown : TGetMouseDownMessage
read FOnMouseDown write FOnMouseDown;
property OnMouseUp : TGetMouseupMessage
read FOnMouseUp write FOnMouseUp;
property OnMouseMove : TGetMouseMoveMessage
read FOnMouseMove write FOnMouseMove;
end;

procedure Register;

implementation

function Play(Code : integer;wParam, lParam : Longint):Longint;stdcall;forward;

var
_Hook : TSysHook;

procedure Register;
begin
RegisterComponents('Samples', [TSysHook]);
end;
{ TSysHook }

constructor TSysHook.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
_Hook := Self;
end;

destructor TSysHook.Destroy;
begin
Enabled := False;
_Hook := nil;
inherited;
end;

function Play(Code, wParam, lParam: Longint): Longint;
begin
Result := 0;
if (Code = HC_ACTION) or (Code =HC_SYSMODALON)or(Code=HC_SYSMODALOFF)then
begin
if Assigned(_Hook.FOnGetMessage) then
_Hook.FOnGetMessage(TEventMsg(lParam));

if TEventMsg(lParam).Message = WM_KEYDOWN then
_Hook.DoKeyDown(TEventMsg(lParam));

if TEventMsg(lParam).Message = WM_KEYUP then
_Hook.DoKeyUp(TEventMsg(lParam));

if (TEventMsg(lParam).Message = WM_LBUTTONDOWN) or
(TEventMsg(lParam).Message = WM_RBUTTONDOWN) or
(TEventMsg(lParam).Message = WM_MBUTTONDOWN) then
_Hook.DoMouseDown(TEventMsg(lParam));

if (TEventMsg(lParam).Message = WM_LBUTTONUP) or
(TEventMsg(lParam).Message = WM_RBUTTONUP) or
(TEventMsg(lParam).Message = WM_MBUTTONUP) then
_Hook.DoMouseUp(TEventMsg(lParam));

if TEventMsg(lParam).Message = WM_MOUSEMOVE then
_Hook.DoMouseMove(TEventMsg(lParam));
end;
if Code < 0 then
Result := CallNextHookEx(_Hook.Handle,Code,wParam,lParam);
end;

procedure TSysHook.DoKeyDown(Msg: TEventMsg);
var
AKey : array [0..1] of Char;
AState : TKeyboardState;
begin
try
GetKeyboardState(AState);
ToAscii(Msg.ParamL,Msg.ParamH,AState,AKey,0);
if Assigned(FOnKeyDown) then
FOnKeyDown(Ord(AKey[0]),GetFocus);
except
end;
end;

procedure TSysHook.DoKeyUp(Msg: TEventMsg);
var
AKey : array [0..1] of Char;
AState : TKeyboardState;
begin
try
GetKeyboardState(AState);
ToAscii(Msg.ParamL,Msg.ParamH,AState,AKey,0);
if Assigned(FOnKeyUp) then
FOnKeyUp(Ord(AKey[0]),GetFocus);
except
end;
end;

procedure TSysHook.DoMouseDown(Msg: TEventMsg);
var
Button : TMouseButton;
begin
Button := mbLeft;
case Msg.Message of
WM_LBUTTONDOWN : button := mbLeft;
WM_RBUTTONDOWN : Button := mbRight;
WM_MBUTTONDOWN : Button := mbMiddle;
end;
if Assigned(FOnMouseDown) then
FOnMouseDown(Button,Msg.Hwnd,Msg.ParamL,Msg.ParamH);
end;

procedure TSysHook.DoMouseMove(Msg: TEventMsg);
begin
if Assigned(FOnMouseMove) then
FOnMouseMove(Msg.ParamL,Msg.ParamH);
end;

procedure TSysHook.DoMouseUp(Msg: TEventMsg);
var
Button : TMouseButton;
begin
Button := mbLeft;
case Msg.Message of
WM_LBUTTONUP : button := mbLeft;
WM_RBUTTONUP : Button := mbRight;
WM_MBUTTONUP : Button := mbMiddle;
end;
if Assigned(FOnMouseUp) then
FOnMouseUp(Button,Msg.Hwnd,Msg.ParamL,Msg.ParamH);
end;

function TSysHook.GetInstance(WinHandle: HWND): DWORD;
begin
Result := GetWindowLong(WinHandle,GWL_HINSTANCE);
end;

function TSysHook.GetProcess(WinHandle: HWND): DWORD;
var
p : DWORD;
begin
GetWindowThreadProcessId(WinHandle,@p);
Result := P;
end;

function TSysHook.GetProcessInfo(AProcessID: DWORD): PProcessEntry32;
var
Snap : THandle;
PE : TProcessEntry32;
PPE : PProcessEntry32;
Found : boolean;
begin
Snap := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS,0);
PE.dwSize := SizeOf(PE);
PPE := nil;
Found := False;
if Process32First(Snap,PE) then
repeat
if (PE.th32ProcessID = AProcessID) then
Found := True;
until (Found = true) or (not Process32Next(Snap,PE));
if Found then
begin
new(PPE);
PPE^ := PE;
end;
Result := PPE;
end;

function TSysHook.GetWinClassName(WinHandle: HWND): string;
var
ClassName : pChar;
begin
GetMem(ClassName,256);
GetClassName(WinHandle,ClassName,256);
Result := string(ClassName);
end;

procedure TSysHook.SetHooking(const Value: boolean);
begin
FHooking := Value;
if Value then
Handle := SetWindowsHookEx(WH_JOURNALRECORD,Play,hInstance,0)
else
UnHookWindowsHookEx(Handle);
end;

end.

type
TForm1 = class(TForm)
private
{ Private declarations }
procedure HookKey(var msg: TWMCessage);message WM_Char;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

procedure TForm1.HookKey(var msg: TWMCessage);
begin
if key = ...
end;

还有没有其他做法

自己程序的当前窗体, 可用写继承窗体消息的方法,如果是泛指桌面的, 那就只能钩子了.

delphi5程序员开发指南上有说明

antic_ant的方法可以

在你的 form 上加一个 ApplicationEvents 控件,然后通过其 OnMessage 来截取消息也行呀!

如,根据用户按键决定继承的父类窗口是否可以关闭:
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;var Handled: Boolean);
begin
inherited;
case Msg.message of
WM_KEYDOWN:
begin
if Msg.wParam=VK_F12 then
if Form1 <> nil then begin
CyberMsgBoxs.Close;
Application.ProcessMessages;
end;
end;
WM_SYSKEYDOWN:
begin
if ((Msg.wParam=VK_F4) or (Msg.wParam=VK_ESCAPE)) then
if (Msg.hwnd=Self.Handle) or (GetParent(Msg.hwnd)=Self.Handle) or
(GetParent((GetParent(Msg.hwnd)))=Self.Handle) then
// 这个if 条件是只判断消息只在这个窗体中有效果
bClosePrompt:=True;// can close the father form;
end;
end;
end;

应该有吧
模式如下：
procdure WMPaint( var message: twmpaint);message WM_PAINT;
我没试过
对你的不知道有没有帮助
如果你需要的消息很多的话

多人接受答案了。