在后台程序中怎么样检测鼠标滚轮是否发生了滚动?

jsandy 2004-09-30 11:53:11
请问在后台程序中怎么样检测鼠标滚轮是否发生了滚动?

当窗口处于当前活动状态时,在
procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); 事件中可以检测到鼠标滚轮滚动的动作,但是窗口不处于活动状态时就检测不到了。
...全文
289 19 打赏 收藏 举报
写回复
19 条回复
切换为时间正序
当前发帖距今超过3年,不再开放新的回复
发表回复
何鲁青 2005-01-14
  • 打赏
  • 举报
回复
收藏了
Kshape 2005-01-14
  • 打赏
  • 举报
回复
[转贴]主程序SPY及其动态连接库MOUSE的原代码和详细注释如下:
{*****************************************************
FILE : MOUSEDLL.DPR mafeitao@371.net 1998/11/18
〉DLL : MOUSEDLL.DLL
EXPORT: sethook 用来安装鼠标钩子函数 mouseproc
unhook 解除对鼠标钩子函数 mouseproc的安装
mouseproc 鼠标钩子函数本身
*****************************************************}
library Mousedll;

uses
Mousep in 'MOUSEP.PAS' {Form1};
exports
sethook,
unhook,
mouseproc;
{$R *.RES}
begin
end.


{*************************************************************
file:Mousep.pas mafeitao@371.net
实现 setHook unHook mouseProc 3个输出函数
*************************************************************}
unit Mousep;

interface

uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls;

{在DLL中也可有FORM型的变量}
type
TForm1 = class(TForm)
Label1: TLabel; {显示wParam}
Label2: TLabel; {显示lParam}
Label3: TLabel; {显示x,y}
Label4: TLabel; {显示hwnd}
Label5: TLabel; {显示window text}
Label6: TLabel;
Label7: TLabel; {显示window class}
private
{ Private declarations }
public
{ Public declarations }
end;

function sethook:bool;export;
function unhook:bool;export;
function mouseProc(code:integer;w:integer;l:longint):bool;export;

var
Form1: TForm1;
idhook:longint;
formok:bool;
implementation
{*********************************************************************
声明安装函数setWindowsHookEx(),
在Delphi中如果用函数setWindowsHook()则不需声明。
微软说函数setWindowsHook已在Windows3.1中废弃,为与Windows3.0兼容仍保留。
实际上该函数setWindowsHook在Windows3.1和Windows95中仍可使用。
{*********************************************************************}
function setwindowsHookEx(id:integer;proc:tfarproc;hinst,htask:thandle):
longint;far;external 'user';
{$R *.DFM}

{安装鼠标钩子函数mouseProc}
function sethook:bool;
var
hinst:thandle; {该动态连接库自己的模块局柄}
proc:tfarproc; {鼠标钩子函数mouseProc的地址}
begin
{在动态连接库中创建form1}
if formok=false then form1:=tform1.create(application) else exit;
formok:=true;{安装form1 后,设置formok,不许再安装form1}
{动态连接库的application指:调用动态连接库的主程序}
form1.show;

{不让用系统菜单来双击关闭Form1}
form1.BorderIcons:=form1.BorderIcons-[biSystemMenu];

hinst:=getModuleHandle('mousedll');
{得到mousedll.dll的模块局柄,即该动态连接库自己的模块局柄}

proc:=getProcAddress(hinst,'mouseProc');
idhook:=setWindowsHookEx(WH_MOUSE,proc,hinst,0);
{用WH_MOUSE参数安装鼠标钩子后,移动鼠标时,系统自动调用mouseProc钩子}
if idhook =0 then sethook:=false else sethook:=true;
end;

{解除鼠标钩子函数mouseProc的安装}
function unhook:bool;
begin
if formok=true then form1.free else exit; {检查form1是否已经关闭}
formok:=false;{关闭了form1,设置formok=0}
if idhook=0 then exit;
unhookWindowsHookEx(idhook);
unhook:=true;
end;

{mouseProc不由应用程序调用,而是在鼠标移动后,由系统调用}
function mouseProc(code:integer;w:integer;l:longint):bool;
var
p:^TMouseHookStruct;
poff:word;
pseg:word;
pmemo:pchar;
begin
if code<0 then begin
mouseProc:=true;
CallNextHookEx(idhook,0,w,l);
end;
if code=HC_NOREMOVE then form1.caption:='HC_NOREMOVE';
form1.caption:='mouse hook';
mouseProc:=false;
{显示系统传来的wParam参数,w是各种鼠标消息的标识符 }
form1.label1.caption:='wParam='+intTostr(w);
{显示系统传来的lParam参数,l是MOUSEHOOKSTRUCT结构的地址}
form1.label2.caption:='lParam='+intTostr(l);

poff:=loword(l); {得到l的低16位}
pseg:=hiword(l); {得到l的高16位}
p:=ptr(pseg,poff); {合成指向MOUSEHOOKSTRUCT结构的指针}

{显示屏幕上鼠标的X,Y坐标}
form1.label3.caption:='pt.x='+intTostr(p^.pt.x)
+' pt.y='+intTostr(p^.pt.y);
{显示屏幕上鼠标下的窗口局柄}
form1.label4.caption:='hwnd='+intTostr(P^.hwnd);

pmemo:=stralloc(20);
getWindowText(p^.hwnd,pmemo,20-1);
{显示鼠标下窗口的标题栏}
form1.label5.caption:=strPas(pmemo);

getClassName(p^.hwnd,pmemo,20-1);
{显示鼠标下窗口的类}
form1.label6.caption:=strPas(pmemo);

strDispose(pmemo);

end;
end.

主程序原代码如下:
{*******************************************
MAINTRY.DPR mafeitao@371.net
******************************************}
program Maintry;

uses
Forms,
Tryp in 'TRYP.PAS' {Form1};

{$R *.RES}

begin
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

{*********************************************
TRYP.PAS mafeitao@371.net
********************************************}

unit Tryp;

interface

uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton; { 安装setHook按钮}
Button2: TButton; { 解除 unHook按钮}
Label1: TLabel; {显示安装,解除是否成功}
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation
function sethook:bool;far;external 'mousedll';
function unhook:bool;far;external 'mousedll';
{声明后自动加载模块mousedll.dll}
{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
if sethook then label1.caption:='set hook ok'; {安装鼠标钩子函数}
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
if unhook then label1.caption:='unhook ok'; {解除鼠标钩子函数}
end;

end.
Kshape 2005-01-14
  • 打赏
  • 举报
回复
我也给你个钩子的例子吧,前人写的(mousep.PAS)
要全部工程实现,给我发消息
================================================
unit Mousep;

interface

uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Label1: TLabel; {显示wParam}
Label2: TLabel; {显示lParam}
Label3: TLabel; {显示x,y}
Label4: TLabel; {显示hwnd}
Label5: TLabel; {显示window text}
Label6: TLabel;
Label7: TLabel; {显示window class}
private
{ Private declarations }
public
{ Public declarations }
end;

function sethook:bool;export;
function unhook:bool;export;
function mouseProc(code:integer;w:integer;l:longint):bool;export;

var
Form1: TForm1;
idhook:longint;
formok:bool;
implementation
{*********************************************************************
声明安装函数setWindowsHookEx(),
在Delphi中如果用函数setWindowsHook()则不需声明。
微软说函数setWindowsHook已在Windows3.1中废弃,为与Windows3.0兼容仍保留。
实际上该函数setWindowsHook在Windows3.1和Windows95中仍可使用。
{*********************************************************************}
function setwindowsHookEx(id:integer;proc:tfarproc;hinst,htask:thandle):
longint;far;external 'user';
{$R *.DFM}

{安装鼠标钩子函数mouseProc}
function sethook:bool;
var
hinst:thandle; {该动态连接库自己的模块局柄}
proc:tfarproc; {鼠标钩子函数mouseProc的地址}
begin
{在动态连接库中创建form1}
if formok=false then form1:=tform1.create(application) else exit;
formok:=true;{安装form1 后,设置formok,不许再安装form1}
{动态连接库的application指:调用动态连接库的主程序}
form1.show;

{不让用系统菜单来双击关闭Form1}
form1.BorderIcons:=form1.BorderIcons-[biSystemMenu];

hinst:=getModuleHandle('mousedll');
{得到mousedll.dll的模块局柄,即该动态连接库自己的模块局柄}

proc:=getProcAddress(hinst,'mouseProc');
idhook:=setWindowsHookEx(WH_MOUSE,proc,hinst,0);
{用WH_MOUSE参数安装鼠标钩子后,移动鼠标时,系统自动调用mouseProc钩子}
if idhook =0 then sethook:=false else sethook:=true;
end;

{解除鼠标钩子函数mouseProc的安装}
function unhook:bool;
begin
if formok=true then form1.free else exit; {检查form1是否已经关闭}
formok:=false;{关闭了form1,设置formok=0}
if idhook=0 then exit;
unhookWindowsHookEx(idhook);
unhook:=true;
end;

{mouseProc不由应用程序调用,而是在鼠标移动后,由系统调用}
function mouseProc(code:integer;w:integer;l:longint):bool;
var
p:^TMouseHookStruct;
poff:word;
pseg:word;
pmemo:pchar;
begin
if code<0 then begin
mouseProc:=true;
CallNextHookEx(idhook,0,w,l);
end;
if code=HC_NOREMOVE then form1.caption:='HC_NOREMOVE';
form1.caption:='mouse hook';
mouseProc:=false;
{显示系统传来的wParam参数,w是各种鼠标消息的标识符 }
form1.label1.caption:='wParam='+intTostr(w);
{显示系统传来的lParam参数,l是MOUSEHOOKSTRUCT结构的地址}
form1.label2.caption:='lParam='+intTostr(l);

poff:=loword(l); {得到l的低16位}
pseg:=hiword(l); {得到l的高16位}
p:=ptr(pseg,poff); {合成指向MOUSEHOOKSTRUCT结构的指针}

{显示屏幕上鼠标的X,Y坐标}
form1.label3.caption:='pt.x='+intTostr(p^.pt.x)
+' pt.y='+intTostr(p^.pt.y);
{显示屏幕上鼠标下的窗口局柄}
form1.label4.caption:='hwnd='+intTostr(P^.hwnd);

pmemo:=stralloc(20);
getWindowText(p^.hwnd,pmemo,20-1);
{显示鼠标下窗口的标题栏}
form1.label5.caption:=strPas(pmemo);

getClassName(p^.hwnd,pmemo,20-1);
{显示鼠标下窗口的类}
form1.label6.caption:=strPas(pmemo);

strDispose(pmemo);

end;
end.
roclui 2005-01-14
  • 打赏
  • 举报
回复
问一个问题,如何识别双滚轮实现上下,左右的操作?
谢谢!
Rex_love_Burger 2004-11-04
  • 打赏
  • 举报
回复
up
jsandy 2004-11-03
  • 打赏
  • 举报
回复
upself
xiyixiaowm50 2004-10-23
  • 打赏
  • 举报
回复
HOOK
masterjames 2004-10-13
  • 打赏
  • 举报
回复
Hook
ssq237712 2004-10-13
  • 打赏
  • 举报
回复
学习
beyondtkl 2004-10-13
  • 打赏
  • 举报
回复
楼上的。。用本进程钩子的话 比较一劳永逸 你如果用鼠标滚动消息拦截需要在客户端区写很多代码
dyzg 2004-10-13
  • 打赏
  • 举报
回复
哪里用得着钩子啊,直接用鼠标滚动消息拦截就可以了
beyondtkl 2004-10-13
  • 打赏
  • 举报
回复
procedure StartHook(hDestWnd, hModule: HWND; iThreadID: DWORD);
begin
if not g_bStarted then
begin
ASSERT(hDestWnd <> 0);
g_hDestWnd := hDestWnd;
g_hModule := hModule;
g_hHook := SetWindowsHookEx(WH_MOUSE, @HookMouseProc, hModule, iThreadID);
g_bStarted := True;
end;
end;

procedure StopHook();
begin
if g_bStarted then
begin
UnHookWindowsHookEx(g_hHook);
g_hHook := 0;
g_hDestWnd := 0;
g_hModule := 0;
g_bStarted := False;
end;
end;
beyondtkl 2004-10-13
  • 打赏
  • 举报
回复
function HookMouseProc(iCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
pMouseHook: MOUSEHOOKSTRUCT;
pt: TPoint;
rect: TRect;
begin
Result := CallNextHookEx(g_hHook, iCode, wParam, lParam);

if iCode >= 0 then
begin
{if not IsMouseNeedHook then
begin
Exit;
end;}
case wParam of
WM_MOUSEMOVE:
begin
// Specifies aPOINT structure that contains the x- and y-coordinates of the cursor, in screen coordinates.
pMouseHook := pMOUSEHOOKSTRUCT(lparam)^;
pt := Point(pMouseHook.pt.X, pMouseHook.pt.Y);
ScreenToClient(g_hDestWnd, pt);
PostMessage(g_hDestWnd, SHOW_MENU_MSG, pt.X, pt.Y);
end;
WM_NCLBUTTONDOWN:
begin
g_CanPost := False;
end;
WM_LBUTTONDOWN: // ÆË×½µ¥»÷ʼþ
begin
// pt := Point(LOWORD(lParam), HIWORD(lParam));
if not g_CanPost then
begin
g_CanPost := True;
end
else
begin
g_CanPost := False; // 04.8.30 TKL Add
GetCursorPos(pt);
ScreenToClient(g_hDestWnd, pt);
PostMessage(g_hDestWnd, MY_MOUSE_LCLICK, pt.X, pt.Y);
end;
end;
WM_NCLBUTTONDBLCLK:
begin
Result := 1;
Exit;
end;
WM_MBUTTONDOWN: YOURS..
The WM_MBUTTONDOWN message is posted when the user presses the middle mouse button while the cursor is in the client area of a window. If the mouse is not captured, the message is posted to the window beneath the cursor. Otherwise, the message is posted to the window that has captured the mouse.

end;
end;
end;
jsandy 2004-10-13
  • 打赏
  • 举报
回复
大侠们帮帮忙啊。
luke5678 2004-10-13
  • 打赏
  • 举报
回复
小弟是来向龙驹GG学习的
jsandy 2004-10-01
  • 打赏
  • 举报
回复
具体怎么实现呀?
飞天揽月 2004-10-01
  • 打赏
  • 举报
回复
捕获鼠标的消息
Bellamy 2004-10-01
  • 打赏
  • 举报
回复
来看看!
beyondtkl 2004-09-30
  • 打赏
  • 举报
回复
MK.你是判断鼠标滚轮在你的客户端的滚动情况么 那可以安一个本进程的鼠标钩子.
相关推荐
发帖
Windows SDK/API

1177

社区成员

Delphi Windows SDK/API
社区管理员
  • Windows SDK/API社区
加入社区
帖子事件
创建了帖子
2004-09-30 11:53
社区公告
暂无公告