Knowing when mouse moves over component

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

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.

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

sorry Nif

rather use this email add.

pdutoit@brillacc.com

Later
BoRiS

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.

 

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

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

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.

Zif

K will do

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

Later
BoRiS

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

d003303,

Yep, let me know how you do this!

BoRiS,

 How are things going?

Regards, ZiF.

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

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.

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.

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

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

Yep, d003303, I'm still waiting on D3.... I'm beginning to hate hospitals....

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

Hi hagen,

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

ZiF.

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.