Главная страница
    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.008 c
14-45008
Шишкин Илья
2003-07-23 10:03
2003.08.14
Помогите найти компонент для работы с mp3

14-44978
Nick Denry
2003-07-30 00:59
2003.08.14
Несчастья...

14-45039
Best Gun
2003-07-19 15:19
2003.08.14
Хочу задать несколько вопросов

14-45153
greenrul
2003-02-13 10:16
2003.08.14
Хитрый вопросец: создание поворачиваемого прицела

14-45049
Marser
2003-07-28 10:26
2003.08.14
Именинники 28 июля




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
Английский Французский Немецкий Итальянский Португальский Русский Испанский