Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Потрепаться";
Текущий архив: 2003.08.14;
Скачать: [xml.tar.bz2];

Вниз

Помогите с 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;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.47 MB
Время: 0.005 c
14-45122
Alexander
2003-05-25 09:06
2003.08.14
Есть COM-расширение контекстного меню проводника от стороннего

14-45114
Dankin
2003-06-03 12:35
2003.08.14
Drag and drop

14-45056
Юля
2003-07-28 07:52
2003.08.14
Орфография

14-45016
Marser
2003-07-29 00:06
2003.08.14
Именинники 29 июля

14-45051
NickBat
2003-07-25 17:12
2003.08.14
Компьютер дома.




Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский