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

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

当窗口处于当前活动状态时，在
procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); 事件中可以检测到鼠标滚轮滚动的动作，但是窗口不处于活动状态时就检测不到了。
...全文
293 19 打赏 收藏 举报
写回复
19 条回复
切换为时间正序
请发表友善的回复…
发表回复
何鲁青 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 ３个输出函数
*************************************************************}
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()，
在Ｄelphi中如果用函数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的低１６位}
pseg:=hiword(l); {得到l的高１６位}
p:=ptr(pseg,poff); {合成指向MOUSEHOOKSTRUCT结构的指针}

{显示屏幕上鼠标的Ｘ，Ｙ坐标}
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()，
在Ｄelphi中如果用函数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的低１６位}
pseg:=hiword(l); {得到l的高１６位}
p:=ptr(pseg,poff); {合成指向MOUSEHOOKSTRUCT结构的指针}

{显示屏幕上鼠标的Ｘ，Ｙ坐标}
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.你是判断鼠标滚轮在你的客户端的滚动情况么 那可以安一个本进程的鼠标钩子.
相关推荐
VB6.0获取鼠标滚轮坐标范例代码.rar
VB6.0获取鼠标滚轮坐标范例代码，其实这是一个获取鼠标坐标的控件，本源码看作是使用此控件的一个例子。在本例中，一方面监控鼠标滚轮是否有滚动行为，另一方面获取滚轮时候的XY坐标，滚动时窗口的文本框中会记录下这些值。一个参考性比较高的鼠标钩子HOOK代码。
鼠标滚轮被遗忘的作用
灵活使用滚轮鼠标的滚轮，可以实现许多意想不到的功能。在Office中除了我们通常所熟悉的浏览(文档、图片或网页等)作用外，滚轮鼠标在Word中还有很多用处，一手按着“Ctrl”键，然后转动鼠标的滚轮时，你会发现文档的视图比例发生了变化，向上滚动放大，向下滚动缩小。用这种方法来调整视图的比例不仅方便，而且调出来的比例比常用工具栏上提供的比例还要丰富（这种方法在Excel、PowerPoint以及AC
键盘事件 与 鼠标滚轮事件
鼠标滚轮事件，需要适配不同浏览器 火狐 DOMMouseScroll进行事件监听 其他 onmousewheel 进行事件监听 其他 中 event.wheelDelta>0 和<0分别是向前滚动和向后滚动 鼠标滚动事件中阻止默认事件时通过 return false来进行操作 altKey ctrlKey shiftKey 分别是判断alt Ctrl shift 三个键是否按下 注：ie 鼠标滚轮向上是120， 向下滚动是-120 opera 鼠标滚轮向上是120， 向下滚动是-120 c.
JS检测鼠标滚轮是否滚动到底部，激活button按钮的点击事件
JS检测鼠标滚轮是否滚动到底部，激活button按钮的点击事件 一、HTML中的文本框和button按钮 &amp;amp;lt;div class=&amp;quot;form-group&amp;quot;&amp;amp;gt; &amp;amp;lt;label class=&amp;quot;col-sm-4 control-label&amp;quot;&amp;amp;gt;考前须知&amp;amp;
CSS 鼠标滚轮滚动横向滚动条的一种另类实现
思路 鼠标滚轮可以滚动元素的纵向滚动条，那么使用css transform变换，使纵向滚动条横向展示，是否可以实现滚轮控制横向滚动效果呢
发帖
Windows SDK/API

1177

社区成员

2.2w+

社区内容

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