Solved

Knowing when mouse moves over component

Posted on 1998-04-23
21
287 Views
Last Modified: 2010-04-06
Yo,

Is somebody there who knows how you can detect a mouse move over ANY component?
I first thought on implementing a hotspot above the component, but what when the components changes position, etc...

Regards, ZiF.
0
Comment
Question by:ZifNab
  • 8
  • 6
  • 4
  • +2
21 Comments
 
LVL 5

Expert Comment

by:inter
Comment Utility
Hi friend,
Let's clarify the problem. Normally we have a good old OnMouseMove event. Please explain the details where this does not work(e.g. when the form is out of focus etc..)
Regards,
Igor
0
 
LVL 8

Author Comment

by:ZifNab
Comment Utility
Hi Inter,

Well, I want something that I can use on any component, without changing that component :

I put a component on form, define which components have to notify this component when mouse moves over them. And not to forget, also define in which state they have to be (e.g. buttons : give me a notify when this button is invisible, ....)

Regards, Zif.
0
 
LVL 4

Expert Comment

by:BoRiS
Comment Utility
Zif why don't you use the CMMOUSEENTER Etc. like so

private    
 procedure CMMouseEnter(var Msg: TMessage); message CM_MOUSEENTER;
 procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;

then pass it like this

procedure TForm1.CMMouseEnter(var Msg: TMessage);
var
  Button : TSpeedButton;
begin
  { anObject is the control over which the mouse is right now }
  Button := TSpeedButton(Msg.lParam);
   if Button <> nil then begin
    Button.Caption := 'Enter';
    Button.Font.Style := [fsBold];
    Button.Font.Color := clYellow;
   end;
  end;

etc.

I have a component I wrote that handles this
email me if want it..

pdutoit@softline.co.za

Later
BoRiS
0
 
LVL 4

Expert Comment

by:BoRiS
Comment Utility
sorry Nif

rather use this email add.

pdutoit@brillacc.com

Later
BoRiS
0
 
LVL 8

Author Comment

by:ZifNab
Comment Utility
Hi BoRiS,

It looks like I have to modify all components. Or not?
That is just what I don't want to do, modify all components! I want to make it possible to get notified when the mouse enters a certain component.
In your code with private declarations of mouse enter and mouse leave, how does that new component knows that the mouse is moving over a certain component?

Regards, Zif.

 
0
 
LVL 4

Expert Comment

by:BoRiS
Comment Utility
Zif

What you can do is pass all the code for the mouseover stuff in the

procedure TForm1.CMMouseEnter(var Msg: TMessage);

like add a label etc.

but give me a hour or two and i'll see if we can asign it to any TWincontrol
like the component I wrote...

Later
BoRiS
0
 
LVL 4

Expert Comment

by:BoRiS
Comment Utility
Zif

Looks like what I gave, you seems to be the only way to change multiple components on one form..., what you can also do is trap the message when the mouse enter's the button and then pass code etc accordingly...but try what I gave you and you'll see that it works well.

Later
BoRiS
0
 
LVL 8

Author Comment

by:ZifNab
Comment Utility
BoRiS,

can you send me that component you spook of?
I 've problems getting connected with your mailbox....
(hot news her in Belgium, somebody escaped from court....)

Tom.Deprez@uz.Kuleuven.ac.be

Thanks already...

Regards, ZiF.
0
 
LVL 4

Expert Comment

by:BoRiS
Comment Utility
Zif

K will do

let me just fix it up a bit
(a bit untidy and all)

Later
BoRiS
0
 
LVL 4

Expert Comment

by:d003303
Comment Utility
Yo Zif,
first a quick note. Components cannot handle mouse or any window messages. Only controls and descendants can. I believe you know, just because of the definition of your question (I'm a little too precise on those thinks, sorry).
Maybe this can help. Drop a button and a label on an empty form. Assign the Form's OnCreate and OnDestroy events and use this code:

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 }
    SaveProc : TWndMethod;
    procedure ProxyWndMethod(var Message: TMessage);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.ProxyWndMethod(var Message: TMessage);
begin
  case Message.msg of
   CM_MOUSEENTER : Label1.Caption := 'Mouse in';
   CM_MOUSELEAVE : Label1.Caption := 'Mouse out';
  end;
  SaveProc(Message);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  SaveProc := Button1.WindowProc;
  Button1.WindowProc := ProxyWndMethod;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Button1.WindowProc := SaveProc;
end;

end.

If you want to handel several controls dynamicaly in one centralized ProxyWndMethod, it is getting a bit tricky. If this is what you want, wanna know how ?

Delphi rules, Linux wins !
Slash/d003303
0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
LVL 8

Author Comment

by:ZifNab
Comment Utility
d003303,

Yep, let me know how you do this!

BoRiS,

 How are things going?

Regards, ZiF.
0
 
LVL 4

Expert Comment

by:d003303
Comment Utility
Hi Zif,
here's what you need. Drop two buttons and a label on a new form. Paste this code and apply the events.

unit Unit1;

interface

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

type

  THandlerControl = class(TPersistent)
  private
    FProxyControlList : TList;
  public
    constructor Create;
    destructor Destroy; override;
    procedure AddControlToList(AControl : TWinControl);
    function RemoveControlFromList(AControl : TWinControl): Boolean;
    procedure NotificationHandler(Sender : TWinControl; var Message: TMessage);
  end;

  THandlerObject = class(TObject)
  private
    FParent : THandlerControl;
    FWinControl : TWinControl;
    FSaveProc : TWndMethod;
    procedure ProxyWndMethod(var Message: TMessage);
  public
    constructor Create(AParent : THandlerControl; AWinControl : TWinControl);
    destructor Destroy; override;
    property WinControl : TWinControl read FWinControl;
  end;

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

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  MyHandler := THandlerControl.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  MyHandler.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  MyHandler.RemoveControlFromList(Button1);
  MyHandler.AddControlToList(Button1);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  MyHandler.RemoveControlFromList(Button2);
  MyHandler.AddControlToList(Button2);
end;

////////////////////////////////////////////////////////////////////////////////

constructor THandlerControl.Create;
begin
  inherited Create;
  FProxyControlList := TList.Create;
end;

destructor THandlerControl.Destroy;
begin
  while FProxyControlList.Count > 0
   do RemoveControlFromList(THandlerObject(FProxyControlList.Items[0]).WinControl);
  FProxyControlList.Free;
  inherited Destroy;
end;

procedure THandlerControl.AddControlToList(AControl : TWinControl);
var NewHandler : THandlerObject;
begin
  NewHandler := THandlerObject.Create(Self, AControl);
  FProxyControlList.Add(NewHandler);
end;

function THandlerControl.RemoveControlFromList(AControl : TWinControl): Boolean;
var Index    : Integer;
begin
  Result := false;
  for Index := 0 to FProxyControlList.Count - 1 do
   if AControl = THandlerObject(FProxyControlList.Items[Index]).WinControl then
    begin
      THandlerObject(FProxyControlList.Items[Index]).Free;
      FProxyControlList.Delete(Index);
      Result := true;
      Break;
    end;
end;

procedure THandlerControl.NotificationHandler(Sender : TWinControl; var Message: TMessage);
begin
  case Message.msg of
   CM_MOUSEENTER : Form1.Label1.Caption := 'Mouse in ' + Sender.Name;
   CM_MOUSELEAVE : Form1.Label1.Caption := 'Mouse out ' + Sender.Name;
  end;
end;

////////////////////////////////////////////////////////////////////////////////

constructor THandlerObject.Create(AParent : THandlerControl; AWinControl : TWinControl);
begin
  inherited Create;
  FParent := AParent;
  FWinControl := AWinControl;
  FSaveProc := FWinControl.WindowProc;
  FWinControl.WindowProc := ProxyWndMethod;
end;

destructor THandlerObject.Destroy;
begin
  FWinControl.WindowProc := FSaveProc;
  inherited Destroy;
end;

procedure THandlerObject.ProxyWndMethod(var Message: TMessage);
begin
  FParent.NotificationHandler(FWinControl, Message);
  FSaveProc(Message);
end;

end.

Have fun,

Slash/d003303
0
 
LVL 8

Author Comment

by:ZifNab
Comment Utility
thanks d003303,

I'll have a close look to it, when I 've some spare time. At the moment, my boss is watching...

Regards, Zif.
0
 
LVL 8

Author Comment

by:ZifNab
Comment Utility
BoRis,

Sorry, I 've to reject your answer, because I really want to have a create a STAND ALONE Component with no extra code to enter in the units.
 

d003003,

Sorry it took so long. I just tested it, but my compiler says that WindowProc doesn't exist.

I looked at Delphi help of TWinControl and indeed I can't find it eihter. Which version of D are you using...?

Zif.
0
 
LVL 4

Expert Comment

by:BoRiS
Comment Utility
Zif

no problem (rejected answer)

Sorry man went on holiday for a while, the component isn't working all that well looks like the answer i gave is the only one i can think of...

maybe Jimbob can add some comments or suggestions to this one, or anyone else ¿¿

but if no solution is found, please award me the points

Later
BoRiS
0
 
LVL 4

Expert Comment

by:d003303
Comment Utility
Hi Zif,
I'm using D3, (I think you use D2 and ordered D3 :-)). Let me take a look if I can subclass the controls with standard API functions, hang on.

Slash/d003303
0
 
LVL 8

Author Comment

by:ZifNab
Comment Utility
Yep, d003303, I'm still waiting on D3.... I'm beginning to hate hospitals....
0
 
LVL 4

Expert Comment

by:d003303
Comment Utility
Hi Zif,
i re-designed the coding and put it into an invisible component that can be manipulated at design time. Unfortunately, the subclassing thing did not work, so this component only runs on D3. So when you got D3, test it out, if you think it is useful I'll post it at Delphi super pages. Anyway, here's the code.

unit HookControl;

interface

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

type
 
  TProxyWndMethod = procedure(Sender : TWinControl; var Message: TMessage) of object;

  TMessageHook = class;
  TMessageHandlerList = class;

  TMessageHandler = class(TCollectionItem)
  private
    FParent      : TMessageHandlerList;
    FWinControl  : TWinControl;
    FControlName : string;
    FSaveProc    : TWndMethod;
    FCallBefore  : Boolean;
    FOnMessage   : TProxyWndMethod;
    procedure ReadData(Reader : TReader);
    procedure WriteData(Writer : TWriter);
    procedure HookControl;
    procedure UnhookControl;
    procedure ProxyWndMethod(var Message: TMessage);
    procedure SetWinControl(NewValue : TWinControl);
    function GetWinControl: TWinControl;
    procedure Loaded;
  protected
    procedure DefineProperties(Filer : TFiler); override;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure Assign(NewValue : TPersistent); override;
  published
    property WinControl : TWinControl read GetWinControl write SetWinControl stored false;
    property CallBefore : Boolean read FCallBefore write FCallBefore default false;
    property OnMessage: TProxyWndMethod read FOnMessage write FOnMessage;
  end;

  TMessageHandlerList = class(TCollection)
  private
    FParent : TMessageHook;
    function GetItem(Index: Integer): TMessageHandler;
    procedure SetItem(Index: Integer; Value: TMessageHandler);
    function CheckDouble(CheckControl : TWinControl): Boolean;
    procedure Loaded;
  protected
    function GetOwner: TPersistent; override;
  public
    constructor Create(AParent : TMessageHook);
    function Add: TMessageHandler;
  published
    property Items[Index: Integer]: TMessageHandler read GetItem write SetItem; default;
  end;

  TMessageHook = class(TComponent)
  private
    FControlList      : TMessageHandlerList;
    FOnMessage        : TProxyWndMethod;
    FHookControlColor : TColor;
    procedure NotificationHandler(Sender : TWinControl; var Message: TMessage);
  protected
    procedure Loaded; override;
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
  published
    property HookControlColor : TColor read FHookControlColor write FHookControlColor default clHighlight;
    property ControlList: TMessageHandlerList read FControlList write FControlList;
    property OnMessage: TProxyWndMethod read FOnMessage write FOnMessage;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Slash', [TMessageHook]);
end;

function Valid(Instance : TObject): Boolean;
var CheckObj : IUnknown;
begin
  Result := true;
  try
    Instance.GetInterface(IUnknown, CheckObj);
  except
    Result := false;
  end;
end;

constructor TMessageHook.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  FControlList := TMessageHandlerList.Create(Self);
  FHookControlColor := clHighlight;
end;

destructor TMessageHook.Destroy;
begin
  FControlList.Free;
  inherited Destroy;
end;

procedure TMessageHook.Loaded;
begin
  inherited Loaded;
  FControlList.Loaded;
end;

procedure TMessageHook.NotificationHandler(Sender : TWinControl; var Message: TMessage);
begin
  if Assigned(FOnMessage)
   then FOnMessage(Sender, Message);
end;

////////////////////////////////////////////////////////////////////////////////

constructor TMessageHandlerList.Create(AParent : TMessageHook);
begin
  inherited Create(TMessageHandler);
  FParent := AParent;
end;

procedure TMessageHandlerList.Loaded;
var Index : Integer;
begin
  for Index := 0 to Count - 1
   do GetItem(Index).Loaded;
end;

function TMessageHandlerList.Add: TMessageHandler;
begin
  Result := TMessageHandler(inherited Add);
end;

function TMessageHandlerList.GetItem(Index: Integer): TMessageHandler;
begin
  Result := TMessageHandler(inherited GetItem(Index));
end;

procedure TMessageHandlerList.SetItem(Index: Integer; Value: TMessageHandler);
begin
  inherited SetItem(Index, Value);
end;

function TMessageHandlerList.GetOwner: TPersistent;
begin
  Result := FParent;
end;

function TMessageHandlerList.CheckDouble(CheckControl : TWinControl): Boolean;
var Index : Integer;
begin
  Result := true;
  for Index := 0 to Count - 1 do
   begin
     if GetItem(Index).FWinControl = CheckControl then
      begin
        Result := false;
        Break;
      end;
   end;
end;

////////////////////////////////////////////////////////////////////////////////

constructor TMessageHandler.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FParent := TMessageHandlerList(Collection);
  FControlName := '';
  FWinControl := nil;
  FSaveProc := nil;
end;

destructor TMessageHandler.Destroy;
begin
  UnhookControl;
  inherited Destroy;
end;

procedure TMessageHandler.DefineProperties(Filer : TFiler);
 function DoWrite: Boolean;
 begin
   Result := Assigned(FWinControl);
 end;
begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('WinControlName', ReadData, WriteData, DoWrite);
end;

procedure TMessageHandler.Loaded;
var AComponent : TComponent;
begin
  if FControlName <> '' then
   begin
     AComponent := FParent.FParent.Owner.FindComponent(FControlName);
     if (AComponent is TWinControl)
      then SetWinControl(TWinControl(AComponent));
   end;
end;

procedure TMessageHandler.ReadData(Reader : TReader);
begin
  FControlName := Reader.ReadString;
end;

procedure TMessageHandler.WriteData(Writer : TWriter);
begin
  Writer.WriteString(FWinControl.Name)
end;

procedure TMessageHandler.HookControl;
begin
  if Assigned(FWinControl) then
   begin
     FSaveProc := FWinControl.WindowProc;
     FWinControl.WindowProc := ProxyWndMethod;
     if Valid(FWinControl)
      then FWinControl.Invalidate;
   end;
end;

procedure TMessageHandler.UnhookControl;
begin
  if Assigned(FWinControl) and Assigned(FSaveProc) then
   begin
     FWinControl.WindowProc := FSaveProc;
     if Valid(FWinControl)
      then FWinControl.Invalidate;
   end;
end;

procedure TMessageHandler.SetWinControl(NewValue : TWinControl);
begin
  if NewValue <> FWinControl then
   if FParent.CheckDouble(NewValue) then
    begin
      UnhookControl;
      FWinControl := NewValue;
      HookControl;
    end
   else Application.MessageBox('Control already hooked.', 'Error', mb_ok or mb_IconExclamation);
end;

function TMessageHandler.GetWinControl: TWinControl;
begin
  if not Valid(FWinControl) then
   begin
     FWinControl := nil;
     FSaveProc := nil;
   end;
  Result := FWinControl;
end;

procedure TMessageHandler.Assign(NewValue : TPersistent);
begin
  inherited Assign(NewValue);
  if NewValue = nil
   then UnhookControl;
  if (NewValue is TMessageHandler) then
   begin
     SetWinControl((NewValue as TMessageHandler).FWinControl);
     FCallBefore := (NewValue as TMessageHandler).CallBefore;
   end;
end;

procedure TMessageHandler.ProxyWndMethod(var Message: TMessage);
var DC         : HDC;
    LogPen     : TLogPen;
    LogBrush   : TLogBrush;
    HPen,
    HPenSave,
    HBrush,
    HBrushSave : THandle;

 procedure CallParentMethod;
 begin
  if FCallBefore
   then FSaveProc(Message);
  if Assigned(FOnMessage)
   then FOnMessage(FWinControl, Message);
  FParent.FParent.NotificationHandler(FWinControl, Message);
  if not FCallBefore
   then FSaveProc(Message);
 end;

begin
  if (Message.Msg = WM_PAINT) and (csDesigning in FParent.FParent.ComponentState) then
   begin
     CallParentMethod;
     DC := GetDC(FWinControl.Handle);
     if DC = 0
      then Exit;
     try
       with LogPen do
        begin
          lopnStyle := PS_DOT;
          lopnWidth.X := 2;
          lopnColor := ColorToRGB(FParent.FParent.FHookControlColor);
        end;
       LogBrush.lbStyle := BS_HOLLOW;
       HPen := CreatePenIndirect(LogPen);
       if HPen <> 0 then
        begin
          HPenSave := SelectObject(DC, HPen);
          try
            HBrush := CreateBrushIndirect(LogBrush);
            if HBrush <> 0 then
             begin
               HBrushSave := SelectObject(DC, HBrush);
               try
                 Windows.Rectangle(DC, 0, 0, FWinControl.Width, FWinControl.Height);
               finally
                 SelectObject(DC, HBrushSave);
                 DeleteObject(HBrush);
               end;
             end;
          finally
            SelectObject(DC, HPenSave);
            DeleteObject(HPen);
          end;
        end;
     finally
       ReleaseDC(FWinControl.Handle, DC);
     end;
   end
  else CallParentMethod;
end;

end.

Have fun,
Slash/d003303
0
 
LVL 2

Accepted Solution

by:
Hagen040798 earned 100 total points
Comment Utility
{Hi ZifNab}

unit Mouse;

interface

uses Controls;

const
  MouseCallback: procedure(AControl: TControl; X, Y: Integer) = nil;

{A Example, this works with Win32 and TControl as Baseclass

unit Main;

type
  TMainForm = class(TForm)
  end;

var
  MainForm: TMainForm;

implementation

uses Mouse;
 
procedure MyMouse(AControl: TControl; X, Y: Integer);
begin
  if MainForm <> nil then
    if AControl <> nil then MainForm.Caption := AControl.Name
      else MainForm.Caption := '';
end;

initialization
  MouseCallback := MyMouse;
end.

End of Example.
You can encapsuled this code in a Component.
Sorry for my english.}

implementation

uses Windows, Messages;

const
  FMouseHook: hHook = 0;
  FInProc: Integer = 0;
  FMouseControl: TControl = nil;

function MouseProc(Code: Integer; wParam: WParam; lParam: LParam): LResult; stdcall; export;
var
  C: TControl;
  P: TPoint;
begin
  if (Code = hc_Action) and (FInProc = 0) then
  try
    Inc(FInProc);  {Disables Recursion's}
    if (wParam = wm_MouseMove) or (wParam = wm_NCMouseMove) then
    begin
      GetCursorPos(P);
      C := FindDragTarget(P, True);
      if C <> FMouseControl then
      begin
        FMouseControl := C;
        if Assigned(MouseCallback) then MouseCallback(FMouseControl, P.X, P.Y);
      end;
    end;
  finally
    Dec(FInProc);
  end;
  Result := CallNextHookEx(FMouseHook, Code, wParam, lParam);
end;

initialization
  FMouseHook := SetWindowsHookEx(WH_MOUSE, MouseProc, 0, GetCurrentThreadID);
finalization
  if FMouseHook <> 0 then UnHookWindowsHookEx(FMouseHook);
  FMouseHook := 0;
end.

0
 
LVL 8

Author Comment

by:ZifNab
Comment Utility
Hi hagen,

Can you give an example of your source as a component?

ZiF.
0
 
LVL 2

Expert Comment

by:Hagen040798
Comment Utility
unit Mouse;

// I have encapsuled the Code in a Component. You must put a TMouseHook on the
//  Form and set the Method OnControlChange and the Property Active to True.
//
// As a Example for the Event

// procedure TMainForm.MouseHook1ControlChange(Control: TControl; X, Y: Integer);
// begin
//   if Control <> nil then Caption := Control.Name else Caption := 'None';
// end;
//
// I'ts so good ??, Hagen.

interface

uses Classes, Controls;

type
  TControlChangeEvent = procedure(Control: TControl; X, Y: Integer) of Object;

  TMouseHook = class(TComponent)
  private
    FOnControlChange: TControlChangeEvent;
    FActive: Boolean;
    procedure SetActive(Value: Boolean);
  protected
    procedure DoControlChange(Control: TControl; X, Y: Integer); virtual;
  public
    destructor Destroy; override;
    function MouseControl: TControl; {current Control under the Mouse}
  published
    property Active: Boolean read FActive write SetActive default False;
    property OnControlChange: TControlChangeEvent read FOnControlChange write FOnControlChange;
  end;

const
  MouseCallback: procedure(AControl: TControl; X, Y: Integer) = nil;

procedure Register;

implementation

uses Windows, Messages;


procedure Register;
begin
  RegisterComponents('Samples', [TMouseHook]);
end;

const
  FMouseHook: hHook = 0;
  FInProc: Integer = 0;
  FMouseControl: TControl = nil;
  FHookList: TList = nil;

function TMouseHook.MouseControl: TControl;
begin
  Result := FMouseControl;
end;

procedure TMouseHook.SetActive(Value: Boolean);
begin
  if Value <> FActive then
  begin
    FActive := Value;
    if FActive then
    begin
      if FHookList = nil then FHookList := TList.Create;
      FHookList.Add(Self);
    end else
      if FHookList <> nil then
      begin
        FHookList.Remove(Self);
        if FHookList.Count = 0 then
        begin
          FHookList.Free;
          FHookList := nil;
        end;
      end;
  end;
end;

procedure TMouseHook.DoControlChange(Control: TControl; X, Y: Integer);
begin
  if (ComponentState * [csLoading, csDestroying, csDesigning] = []) and
     Assigned(FOnControlChange) then FOnControlChange(Control, X, Y);
end;

destructor TMouseHook.Destroy;
begin
  Active := False;
  inherited Destroy;
end;

function MouseProc(Code: Integer; wParam: WParam; lParam: LParam): LResult; stdcall; export;
var
  C: TControl;
  P: TPoint;
  I: Integer;
begin
  if (Code = hc_Action) and (FInProc = 0) then
  try
    Inc(FInProc);  {Disables Recursion's}
    if (wParam = wm_MouseMove) or (wParam = wm_NCMouseMove) then
    begin
      GetCursorPos(P);
      C := FindDragTarget(P, True);
      if C <> FMouseControl then
      begin
        FMouseControl := C;
        if Assigned(MouseCallback) then MouseCallback(FMouseControl, P.X, P.Y);
        if Assigned(FHookList) then
          for I := FHookList.Count-1 downto 0 do
            TMouseHook(FHookList[I]).DoControlChange(FMouseControl, P.X, P.Y);
      end;
    end;
  finally
    Dec(FInProc);
  end;
  Result := CallNextHookEx(FMouseHook, Code, wParam, lParam);
end;

initialization
  FMouseHook := SetWindowsHookEx(WH_MOUSE, MouseProc, 0, GetCurrentThreadID);
finalization
  if FMouseHook <> 0 then UnHookWindowsHookEx(FMouseHook);
  FMouseHook := 0;
  FHookList.Free;
  FHookList := nil;
end.

0

Featured Post

How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

Join & Write a Comment

Suggested Solutions

Title # Comments Views Activity
Strange message in Delphi 10 Seattle 1 463
Magic Software info 18 101
LAN or WAN ? 11 58
TEMBEDDEDWB how can i change its user agent ? 8 26
Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
This video discusses moving either the default database or any database to a new volume.
In this tutorial you'll learn about bandwidth monitoring with flows and packet sniffing with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're interested in additional methods for monitoring bandwidt…

771 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

9 Experts available now in Live!

Get 1:1 Help Now