Catch A mouse Click

This code here only catches clicks made on Form1... is it possible to catch the clicks globally with D4...

This code here was a mostly ckaneta with some of my code to get hold of windows handles and MORE to the point, catch a click IE left mouse click, this code was to do this... but it failed, so looking for a soloution... mouse_event, Capturemouse... Nothing from what i can see helps... this was the best option.

                   unit Unit1;

                   interface

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

                   type
                     TForm1 = class(TForm)
                       Button1: TButton;
                       Edit1: TEdit;
                       Edit2: TEdit;
                       Edit3: TEdit;
                       Button2: TButton;
                       Button3: TButton;
                       Label1: TLabel;

                       procedure MessageLoop(var Msg:TMsg;var Handled:Boolean);
                       procedure FormCreate(Sender: TObject);
                     private
                       { Private declarations }
                     public
                       { Public declarations }
                     end;

                   var
                     Form1: TForm1;
                     p : TPoint;
                     num,num1,num2: integer;

                   implementation

                   {$R *.DFM}
                   {------------------------------------------------------------------------------}
                   procedure TForm1.MessageLoop(var Msg: TMsg; var Handled: Boolean);
                   var W : TWinControl;
                    begin
                     if (Msg.Message = WM_LBUTTONDOWN) or (Msg.Message = WM_LBUTTONUP) then begin
                      num:=getmessagepos();
                      num1:=hiword(num);   num2:=loword(num);
                      p.y:=num1;           p.x:=num2;
                      edit1.text:=inttostr(num2);
                      edit2.text:=inttostr(num1);
                      edit3.text:=inttostr(wnd);
                      w:=FindVCLWindow( P );
                      if w <> nil then label1.caption:=w.Name;
                     end;
                    end;
                   procedure TForm1.FormCreate(Sender: TObject);
                    begin application.OnMessage:=MessageLoop; end;

                   end.

Ok thanks for anyhelp on this :) thanks all

Craig C. (setting as an easy question for now, since the hard work (i think) has been done)
LVL 2
craig_capelAsked:
Who is Participating?
 
mullet_attackConnect With a Mentor Commented:
Craig,
I have never tried to load a D5 project into D4, and yes, I got an "unsupported 16 bit resource" error when I tried. A bit of an odd message.

However, load the thing into D4, ignore the errors, then remove form1 and form3 from the project. Add a new form1, and rebuild it. It should work then. It did for me. You didn't mention whether the exe I sent worked or not. I'd be supprised if it didn't.

I'll email you the D4 project just in case.

Mark
0
 
intheCommented:
probably a wh_mouse hook would be better,someone must have example handy to paste (ive no time at moment,so just listening..)
0
 
craig_capelAuthor Commented:
okey....
0
2018 Annual Membership Survey

Here at Experts Exchange, we strive to give members the best experience. Help us improve the site by taking this survey today! (Bonus: Be entered to win a great tech prize for participating!)

 
Alisher_NCommented:
type
  TForm1 = class(TForm)

  private

  public
    { Public declarations }
    Procedure MyMouse( var Msg: TWMMove ); message WM_MBUTTONDOWN;
  end;

Procedure TForm1.MyMouse( var Msg: TWMMove );
var
  s1,s2 : String;
begin
 // some bla bla code with Msg.*
  Str( Msg.XPos, s1 );
  Form1.Label1.Caption := s1;
  Str( Msg.Ypos, s2 );
  Form1.Label2.Caption := s2;
end;
0
 
bryan7Commented:
listenning
0
 
craig_capelAuthor Commented:
hmmm, So I would do something like this?

type
                     TForm1 = class(TForm)

                     private

                     public
                       { Public declarations }
                       Procedure MyMouse( var Msg: TWMMove ); message WM_MBUTTONDOWN;
                     end;

                   Procedure TForm1.MyMouse( var Msg: TWMMove );
                   var
                     s1,s2 : String;
                   begin
                    // some bla bla code with Msg.*
      if msg.msg=wm_lbuttondown then begin
                     Str( Msg.XPos, s1 );
                     Form1.Label1.Caption := s1;
                     Str( Msg.Ypos, s2 );
                     Form1.Label2.Caption := s2;
       end;
                   end;


Well the bad news is even with the if statement there OR not, it does not make the slightest bit of difference... Msg.xpos does not show.... I dont think this procedure even is kicking in....

Thanks
0
 
craig_capelAuthor Commented:
Adjusted points to 100
0
 
craig_capelAuthor Commented:
Ok i have this... Someone Here actually get this to compile i will be amazed (with MousebuttonDown)... upping the points....




HookMainWindow is declared under TApplication as follows:

procedure HookMainWindow(Hook : TWindowHook);

Notice that HookMainWindow takes one parameter, Hook of type TWindowHook. TWindowHook is a method pointer type
that's defined like so:

type
  TWindowHook = function(var Message : TMessage) : Boolean of object;

Since TWindowHook is a method pointer, you can define your own method as the hook function as long as it follows the
nomenclature defined for TWindowHook. Notice that the return value of the function is of type Boolean. This is the
equivalent of the "Handled" parameter of OnMessage. If your function handles a particular message, you'd return true. This
will be passed back to the Application's WndProc and message processing for that message will be terminated. Otherwise,
you'd return False. Here's an example method:

function TForm1.AppHookFunc(var Message : TMessage) : Boolean;
begin
  Result := False; //I just do this by default
  if Message.Msg = WM_<SomethingOrOther> then begin
    ...DoSomething...
    Result := True;
  end;
end;

Okay, now that we've set up everything, we need to make the application hook the messages. This can be done in the main
form's OnCreate method:

function TForm1.FormCreate(Sender : TObject);
begin
  HookMainWindow(AppHookFunc);
end;


got it from the net, for the life of me, getting it to work would be good, but i think this is what i need....
0
 
rwilson032697Commented:
Well, this compiles, but doesn't seem to catch the mouse downs - messages are going through the hook though...

Cheers,

Raymond.

unit Unit16;

interface

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

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    function AppHookFunc(var Message : TMessage) : Boolean;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

type
  TWindowHook = function(var Message : TMessage) : Boolean of object;

function TForm1.AppHookFunc(var Message : TMessage) : Boolean;
begin
  Result := False; //I just do this by default
  if Message.Msg = WM_LBUTTONDOWN then
    begin
      ShowMessage('Bingo');
      Result := True;
    end;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.HookMainWindow(AppHookFunc);
end;

end.
0
 
Alisher_NCommented:
OK, I've got it

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    Procedure AppMessage(var Msg: TMsg; var Handled: Boolean);
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.AppMessage(var Msg: TMsg; var Handled: Boolean);
begin
  if Msg.message = WM_RBUTTONDOWN then
  begin
{    Msg.Lparam}
    ShowMessage( 'Duh!' );
    Handled := True;
  end;

  { for all other messages, Handled remains False }
  { so that other message handlers can respond }
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnMessage := AppMessage;
end;

end.
0
 
craig_capelAuthor Commented:
Back to Same problem... the fisrt bit of code i pasted does exaclty what your code does Alisher :)

It captures the clicks on the form... but if i click on the start button... it simply does not cath it :)


I am thinking this is not possible, I think a DLL is in need.... Take pcanywhere, or Laplink, as if you can capture the mouse clicks and say... do the same at the other end?....

Thanks for the help....

0
 
kambizCommented:
Hi,

A few days ago, I had a question about "Capturing Windows Messages". Raymond (rwilson) gave me a sample keyboard hook and I expanded it for all Windows messages.

If you think this may helps you, send e-mail to me.

My e-mail is khojasteh@www.dci.co.ir

Kambiz
0
 
intheCommented:
Hi Craig,
still listening and think your probably just needing something like this below(for system wide need a dll for globaly for a form then this will work fine):
Regards Barry


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  HGetMessageHook : THandle = 0;
implementation

{$R *.DFM}

function GetMessageHook(Code, wParam, lParam: Integer): Integer; stdcall; var
  M: TMsg;
  Msg: Integer;
begin
  Result:= 0;
  if (Code >= 0)
  and Assigned(Application)
  and Application.Active
  and (not IsIconic(GetActiveWindow))
  then begin
    M:= PMsg(lParam)^;
    Msg:= PMsg(lParam)^.Message;
    if ((Msg >= wm_LButtonDblClk) and (Msg <= wm_MButtonDblClk))
    or ((Msg >= wm_NCRButtonDblClk) and (Msg <= wm_NCMButtonDblClk))
    or (Msg = wm_LButtonDown)
    or (Msg = wm_NCLButtonDown)
    or (Msg = wm_NCRButtonDown)
    then begin
    Form1.label1.caption := 'hello';
    //dont do showmessage cause you wont be able to close the
    //message the dialog :-)
      Exit;
    end;
  end;
  Result:= CallNextHookEx(HGetMessageHook, Code, wParam, lParam);
  end;


procedure TForm1.FormCreate(Sender: TObject);
begin
if HGetMessageHook = 0
then HGetMessageHook:= SetWindowsHookEx(wh_GetMessage, @GetMessageHook, 0, GetCurrentThreadID);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
if HGetMessageHook <> 0
  then UnhookWindowsHookEx(HGetMessageHook);
  HGetMessageHook:= 0;
end;

end.
0
 
craig_capelAuthor Commented:
Adjusted points to 123
0
 
craig_capelAuthor Commented:
Hi Barry thanks for the code... but the very fisrt example i posted did what you just showed me....


Barry, How would you go about a dll, A) never made one B) they look hard to do.... Shall i just give up now?


Thanks Craig C.
0
 
intheCommented:
ok so i see you do want to catch "system wide" so definetly need to have a dll,first email kambiz to try his solution and let us know how it goes,if it dont work i post one.
0
 
craig_capelAuthor Commented:
ok will do thanks... i dont suppose you have a link to how to create a dll in Delphi? just a starter pointer?


Thanks Craig C.
0
 
rwilson032697Commented:
Go File|New... and select DLL from the list :o)

Cheers,

Raymond.
0
 
craig_capelAuthor Commented:
Raymond... thanks for the brilliant piece of help... i have never seen that option before in Delphi :)

But Really now.... I have this though still :)


                // "hook.dpr" - DLL project

                library hook;

                uses windows, messages, commctrl;

                {$ifndef ver120} type cardinal = integer; {$endif}

                function HookMessageProc(code, wParam, lParam: integer) : integer; stdcall;
                begin
                  result:=0;
                end;

                exports HookMessageProc;

                type TDesktopItems  = record
                                        itemCount : integer;
                                        items     : array [0..$FFFE] of record
                                                      pos  : TPoint;
                                                      name : array [0..MAX_PATH] of char;
                                                    end;
                                      end;
                     TPDesktopItems = ^TDesktopItems;

                var fm  : cardinal;
                    pdi : TPDesktopItems;
                    lv  : cardinal;
                    i1  : integer;
                    lvi : TLVItem;
                    ev  : cardinal;
                begin
                  lv:=FindWindowEx(FindWindowEx(FindWindow('Progman','Program Manager'),0,'SHELLDLL_DefView',''),0,'SysListView32','');
                  if (lv<>0) and (GetCurrentThreadID=GetWindowThreadProcessID(lv,nil)) then begin
                    fm:=OpenFileMapping(FILE_MAP_ALL_ACCESS,false,'mappedMemoryForDesktopIcons');
                    if fm<>0 then
                      try
                        pdi:=MapViewOfFile(fm,FILE_MAP_ALL_ACCESS,0,0,0);
                        if pdi<>nil then
                          try
                            with pdi^ do begin
                              i1:=SendMessage(lv,LVM_GETITEMCOUNT,0,0);
                              if i1<itemCount then itemCount:=i1;
                              zeroMemory(@lvi,sizeOf(TLVItem));
                              for i1:=0 to itemCount-1 do begin
                                SendMessage(lv,LVM_GETITEMPOSITION,i1,integer(@items[i1].pos));
                                with lvi do begin mask:=LVIF_TEXT; iSubItem:=0; pszText:=items[i1].name; cchTextMax:=MAX_PATH end;
                                items[i1].name[SendMessage(lv,LVM_GETITEMTEXT,i1,integer(@lvi))]:=#0;
                              end;
                            end;
                          finally UnMapViewOfFile(pdi) end;
                      finally CloseHandle(fm) end;
                    ev:=OpenEvent(EVENT_ALL_ACCESS,false,'eventForDesktopIcons');
                    if ev<>0 then
                      try
                        SetEvent(ev);
                      finally CloseHandle(ev) end;
                  end;
                end.

But.... like that REALLY helps me :) Thanks all...
0
 
gandalf_the_whiteCommented:
listening...
0
 
mullet_attackCommented:
This works for global mouse messages, and doesn't need to be a dll.

program Project1;

uses
  Forms,
  Messages,
  Windows,
  Unit1 in 'Unit1.pas' {Form1},
  Unit2 in 'Unit2.pas',

{$R *.RES}

begin
 try
  GlobalMouseHandler := TGlobalMouseHandler.create;
  Application.Initialize;
  GlobalMouseHandler.SetHook;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
 finally
  GlobalMouseHandler.FreeHook;
 end;
end.

unit Unit2;

interface

uses
  Windows, Messages, Sysutils, controls, Forms;

type
TGlobalMouseHandler = class
  public
    hHook : longint;
    procedure SetHook;
    procedure FreeHook;
  end;

function MouseProc(Code, wParam, lParam: Integer): longint;stdcall;

var
  GlobalMouseHandler : TGlobalMouseHandler;

implementation

{ TGlobalMouseHandler }

function MouseProc(Code, wParam, lParam: Integer): longint;stdcall;
begin
  if Code < 0 then
    begin
      result := CallNextHookEx(GlobalMousehandler.hHook,Code,wParam,lParam);
      exit;
    end;
  if ((wParam = WM_NCLBUTTONDOWN) or (wParam = WM_LBUTTONDOWN)) then beep;
  result := 0;
end;

procedure TGlobalMouseHandler.FreeHook;
begin
  UnHookWindowsHookEx(GlobalMousehandler.hHook);
end;

procedure TGlobalMouseHandler.SetHook;
begin
  hHook := SetWindowsHookEx(wh_Mouse,MouseProc,hInstance,0);
end;

end.

it just beeps when you click
0
 
craig_capelAuthor Commented:
Would love to accept.... but its simply not wanting to compile, it goes on about Form1 not being correct or something...

 program Project1;

                   uses
                     Forms,
                     Messages,
                     Windows,
                     Unit1 in 'Unit1.pas' {Form1},
                     Unit2 in 'Unit2.pas',

                   {$R *.RES}

                   begin
                    try
                     GlobalMouseHandler := TGlobalMouseHandler.create;
                     Application.Initialize;
                     GlobalMouseHandler.SetHook;
                     Application.CreateForm(TForm1, Form1);
                     Application.Run;
                    finally
                     GlobalMouseHandler.FreeHook;
                    end;
                   end.


unit Unit1;

interface

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


    TGlobalMouseHandler = class
                     public
                       hHook : longint;
                       procedure SetHook;
                       procedure FreeHook;
                     end



  function MouseProc(Code, wParam, lParam: Integer): longint;stdcall;

                   var
                     GlobalMouseHandler : TGlobalMouseHandler;


implementation

{$R *.DFM}

function MouseProc(Code, wParam, lParam: Integer): longint;stdcall;
                   begin
                     if Code < 0 then
                       begin
                         result := CallNextHookEx(GlobalMousehandler.hHook,Code,wParam,lParam);
                         exit;
                       end;
                     if ((wParam = WM_NCLBUTTONDOWN) or (wParam = WM_LBUTTONDOWN)) then beep;
                     result := 0;
                   end;

                   procedure TGlobalMouseHandler.FreeHook;
                   begin
                     UnHookWindowsHookEx(GlobalMousehandler.hHook);
                   end;

                   procedure TGlobalMouseHandler.SetHook;
                   begin
                     hHook := SetWindowsHookEx(wh_Mouse,MouseProc,hInstance,0);
                   end;


end.


I think i am messing up somewhere.... Could you give me a couple of steps.... its giving me a headache.... thanks...
0
 
mullet_attackCommented:
Start a new application, with a single form (form1, unit 1).

save it as 'project1' somewhere.

Add a new unit, save it as 'unit2'

cut and paste code from my 'project1.dpr' into your dpr.

cut and paste the code from my 'unit2' into your unit 2.
it will compile and run.

Your problem was you put the unit2 code into your unit1.

The only reason I included unit1/Form1 is for you to put buttons etc on it for testing.

If you still have no luck, I can e-mail you the project
0
 
craig_capelAuthor Commented:
wow... i am impressed, It caused more memory global page faults in 1 min that i have seen in a year? and nope i did what you said... it compiled it ran, i am using Delphi 4, and i think thats the problem... if your source code works fine, could you email me the exe as well? then the points are yours for the taking

Thanks Craig C.....
0
 
craig_capelAuthor Commented:
oops... craig@tenerife1.com  will do just nicely :) thanks.....
0
 
craig_capelAuthor Commented:
Got your email thanks.... but for some reason... your code WILL NOT compile with Delphi 4, something about 32bit something or other.... i will continue to get this code here to work..... I really would like to give you the points..... I badly need this code to work....
0
 
craig_capelAuthor Commented:
ok got your last emai... noticed your in 1024 x 768, Form was massive on my 800 x 600 res.... Thanks and you get your well deserved points....

Craig C.
0
All Courses

From novice to tech pro — start learning today.