Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2003.08.14;
Скачать: CL | DM;

Вниз

Помогите с HOOKом на мышь   Найти похожие ветки 

 
AMO ©   (2003-06-12 17:02) [0]

Доброе время суток!
Пожалуйста подскажите в чем ошибка. В DLLке ставится HOOK на мышь,а обработка сообщений производится в форме. После запуска программы пара движений мышью и все зависает.
library MHookKoord;

uses
SysUtils,
Classes,
Messages,
Windows;

{$R *.res}
var
idHook: THandle;
R:TRect;
Text: PChar;
x, y, i: Integer;

function SysMsgProc(code : integer; wParam : word; lParam : longint) : longint; stdcall;
var w: hWnd;

begin
if code = HC_ACTION then
begin
SendMessage(FindWindow(nil,"Работа с мышью"),WM_USER + 101,0,lParam);
end;
Result:= CallNextHookEx(idHook, Code, wParam, lParam);
end;


function hook(switch: Boolean):BOOL; export; stdcall;
begin

if switch then
idHook := SetWindowsHookEx(WH_MOUSE , @SysMsgProc, HInstance, 0);
else
Result:=UnhookWindowsHookEx(idHook);
end;

exports
hook name "hook";

begin
end.

unit Unit1;

interface

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

type
TForm1 = class(TForm)
lblTextWind: TLabel;
edtTextWind: TEdit;
Label2: TLabel;
lblX: TLabel;
edtX: TEdit;
lblY: TLabel;
edtY: TEdit;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
procedure WMMouseHook(var Message: TMessage); message WM_USER + 101;

end;

function hook(switch: Boolean):BOOL; export; stdcall;

var
Form1: TForm1;
p: Boolean;
buff: array [0..127] of Char;
i: Integer;
implementation

{$R *.dfm}
function hook(switch: Boolean):BOOL; external "MHookKoord.dll" name "hook";

procedure TForm1.WMMouseHook(var Message: TMessage);

begin
( MOUSEHOOKSTRUCT(Pointer(Message.lParam)
Доброе время суток!
Пожалуйста подскажите в чем ошибка. В DLLке ставится HOOK на мышь,а обработка сообщений производится в форме. После запуска программы пара движений мышью и все зависает.
library MHookKoord;

uses
SysUtils,
Classes,
Messages,
Windows;

{$R *.res}
var
idHook: THandle;
R:TRect;
Text: PChar;
x, y, i: Integer;

function SysMsgProc(code : integer; wParam : word; lParam : longint) : longint; stdcall;
var w: hWnd;

begin
if code = HC_ACTION then
begin
SendMessage(FindWindow(nil,"Работа с мышью"),WM_USER + 101,0,lParam);
end;
Result:= CallNextHookEx(idHook, Code, wParam, lParam);
end;


function hook(switch: Boolean):BOOL; export; stdcall;
begin

if switch then
idHook := SetWindowsHookEx(WH_MOUSE , @SysMsgProc, HInstance, 0);
else
Result:=UnhookWindowsHookEx(idHook);
end;

exports
hook name "hook";

begin
end.

unit Unit1;

interface

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

type
TForm1 = class(TForm)
lblTextWind: TLabel;
edtTextWind: TEdit;
Label2: TLabel;
lblX: TLabel;
edtX: TEdit;
lblY: TLabel;
edtY: TEdit;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
procedure WMMouseHook(var Message: TMessage); message WM_USER + 101;

end;

function hook(switch: Boolean):BOOL; export; stdcall;

var
Form1: TForm1;
p: Boolean;
buff: array [0..127] of Char;
i: Integer;
implementation

{$R *.dfm}
function hook(switch: Boolean):BOOL; external "MHookKoord.dll" name "hook";

procedure TForm1.WMMouseHook(var Message: TMessage);

begin
i:= GetWindowText(MOUSEHOOKSTRUCT(Pointer(Message.lParam)^).hwnd,buff,sizeof(buff));
edtX.Text:=IntToStr(MOUSEHOOKSTRUCT(Pointer(Message.lParam)^).pt.X);
edtY.Text:=IntToStr(MOUSEHOOKSTRUCT(Pointer(Message.lParam)^).pt.Y);
edtTextWind.Text:=String(buff);

end;


procedure TForm1.Button1Click(Sender: TObject);
begin
If p then
begin
hook(True);
p:=False;
Button1.Caption:="Снять ловушку";
end
else
begin
hook(False);
p:=True;
Button1.Caption:="Установить ловушку";
end;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
p:=True;
Button1.Caption:="Установить ловушку";
end;

end.


 
VMcL ©   (2003-06-12 17:57) [1]

>AMO © (12.06.03 17:02)
>Пожалуйста подскажите в чем ошибка.

В ДНК.


 
VMcL ©   (2003-06-12 18:00) [2]

function SysMsgProc(code : integer; wParam : word {?!!!}; lParam : longint) : longint; stdcall;


 
AMO ©   (2003-06-12 18:32) [3]

Можно по подробнее. Мне нужно отлавливать координаты мыши и заголовок окна под курсором.
Немного исправлено:

library MHookKoord;

uses
SysUtils,
Classes,
Messages,
Windows;

{$R *.res}
var
idHook: THandle;
R:TRect;
Text: PChar;
x, y, i: Integer;

function HookProc(code : integer; wParam : word; lParam : longint) : longint; stdcall;
var w: hWnd;

begin
if code = HC_ACTION then
begin
SendMessage(FindWindow(nil,"Работа с мышью"),WM_USER + 101,0,lParam);
end;
Result:= CallNextHookEx(idHook, Code, wParam, lParam);
end;


function hook(switch: Boolean):BOOL; export; stdcall;
begin

if switch then
idHook := SetWindowsHookEx(WH_MOUSE , @HookProc, HInstance, 0);
else
Result:=UnhookWindowsHookEx(idHook);
end;

exports
hook name "hook";

begin
end.

unit Unit1;

interface

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

type
TForm1 = class(TForm)
lblTextWind: TLabel;
edtTextWind: TEdit;
Label2: TLabel;
lblX: TLabel;
edtX: TEdit;
lblY: TLabel;
edtY: TEdit;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
( var Message: TMessage)
Можно по подробнее. Мне нужно отлавливать координаты мыши и заголовок окна под курсором.
Немного исправлено:

library MHookKoord;

uses
SysUtils,
Classes,
Messages,
Windows;

{$R *.res}
var
idHook: THandle;
R:TRect;
Text: PChar;
x, y, i: Integer;

function HookProc(code : integer; wParam : word; lParam : longint) : longint; stdcall;
var w: hWnd;

begin
if code = HC_ACTION then
begin
SendMessage(FindWindow(nil,"Работа с мышью"),WM_USER + 101,0,lParam);
end;
Result:= CallNextHookEx(idHook, Code, wParam, lParam);
end;


function hook(switch: Boolean):BOOL; export; stdcall;
begin

if switch then
idHook := SetWindowsHookEx(WH_MOUSE , @HookProc, HInstance, 0);
else
Result:=UnhookWindowsHookEx(idHook);
end;

exports
hook name "hook";

begin
end.

unit Unit1;

interface

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

type
TForm1 = class(TForm)
lblTextWind: TLabel;
edtTextWind: TEdit;
Label2: TLabel;
lblX: TLabel;
edtX: TEdit;
lblY: TLabel;
edtY: TEdit;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
procedure WMMouseHook(var Message: TMessage); message WM_USER + 101;

end;

function hook(switch: Boolean):BOOL; export; stdcall;

var
Form1: TForm1;
p: Boolean;
buff: array [0..127] of Char;
i: Integer;
implementation

{$R *.dfm}
function hook(switch: Boolean):BOOL; external "MHookKoord.dll" name "hook";

procedure TForm1.WMMouseHook(var Message: TMessage);

begin
i:= GetWindowText(MOUSEHOOKSTRUCT(Pointer(Message.lParam)^).hwnd,buff,sizeof(buff));
edtX.Text:=IntToStr(MOUSEHOOKSTRUCT(Pointer(Message.lParam)^).pt.X);
edtY.Text:=IntToStr(MOUSEHOOKSTRUCT(Pointer(Message.lParam)^).pt.Y);
edtTextWind.Text:=String(buff);

end;


procedure TForm1.Button1Click(Sender: TObject);
begin
If p then
begin
hook(True);
p:=False;
Button1.Caption:="Снять ловушку";
end
else
begin
hook(False);
p:=True;
Button1.Caption:="Установить ловушку";
end;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
p:=True;
Button1.Caption:="Установить ловушку";
end;

end.



 
VMcL ©   (2003-06-12 19:15) [4]

>AMO © (12.06.03 18:32)

function SysMsgProc(code : integer; wParam : {word !} longint; lParam : longint) : longint; stdcall;



Страницы: 1 вся ветка

Текущий архив: 2003.08.14;
Скачать: CL | DM;

Наверх




Память: 0.49 MB
Время: 0.012 c
14-45045
GROL
2003-07-26 21:20
2003.08.14
Нужен графический движок для CAD


14-44961
Franzy
2003-07-30 13:56
2003.08.14
Где взять стандартные иконки windows?!


14-45085
KODer
2003-06-14 15:46
2003.08.14
Дублированные функции???


14-45163
Soft
2003-07-30 15:35
2003.08.14
Зачем платить больше


14-45073
Sheng
2003-07-27 00:39
2003.08.14
Про совместимость dfm-файлов