Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

How to detect if mouse is over a control or any child thereof

Tags:

delphi

I wanted to have my panel automatically shrink when the mouse moves out of it but, using MouseEnter and MouseLeave doesn't work because the mouse 'leaves' when I mouse over any child control.

This is a fairly common use case but I can't seem to find the right question to ask.

Here is an example: You can see that if the main form is covered with components (which is common in actual applications) the Form.MouseEnter event never fires.

object Form14: TForm14
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 314
  ClientWidth = 514
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -12
  Font.Name = 'Segoe UI'
  Font.Style = []
  OnMouseEnter = FormMouseEnter
  TextHeight = 15
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 514
    Height = 25
    Align = alTop
    Caption = 'This panel should grow when the mouse moves over it.'
    TabOrder = 0
    VerticalAlignment = taAlignTop
    OnMouseEnter = Panel1MouseEnter
    object ComboBox1: TComboBox
      Left = 48
      Top = 36
      Width = 145
      Height = 23
      TabOrder = 0
      Text = 'ComboBox1'
    end
    object Button1: TButton
      Left = 212
      Top = 34
      Width = 75
      Height = 25
      Caption = 'Button1'
      TabOrder = 1
    end
  end
  object Panel2: TPanel
    Left = 0
    Top = 25
    Width = 185
    Height = 289
    Align = alLeft
    Caption = 'Panel2'
    TabOrder = 1
    ExplicitLeft = 12
    ExplicitTop = 12
    ExplicitHeight = 41
  end
  object Panel3: TPanel
    Left = 185
    Top = 25
    Width = 329
    Height = 289
    Align = alClient
    Caption = 'Panel3'
    TabOrder = 2
    OnMouseEnter = FormMouseEnter
    ExplicitLeft = 24
    ExplicitTop = 24
    ExplicitWidth = 185
    ExplicitHeight = 41
  end
end

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm14 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    ComboBox1: TComboBox;
    Button1: TButton;
    procedure FormMouseEnter(Sender: TObject);
    procedure Panel1MouseEnter(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form14: TForm14;

implementation

{$R *.dfm}

procedure TForm14.FormMouseEnter(Sender: TObject);
begin
  Panel1.Height := 25;
end;

procedure TForm14.Panel1MouseEnter(Sender: TObject);
begin
  Panel1.Height := 64;
end;

end.
like image 631
Koot33 Avatar asked Dec 22 '25 06:12

Koot33


1 Answers

Luckily, after posting the question a bunch of topics came up that pointed me in the right direction. You need to use the application events OnMessage to hook the windows messages and look for mouse move events. I added the following code and it now works as expected. I think I'll probably run into some complications with further testing but it looks promising. Also, I'm thinking I should add code to only hook messages when the panel is expanded.

procedure TForm1.ApplicationEvents1Message(var Msg: TMsg; var Handled: Boolean);
var
  pt: TPoint;
begin
  if (Msg.message = WM_MOUSEMOVE) or (Msg.message = WM_NCMOUSEMOVE) then
  begin
    if (Panel1.Height > 25) then
    begin
      pt := ScreenToClient(Mouse.CursorPos);
      if not PtInRect(Panel1.BoundsRect, pt) then
        Panel1.Height := 25;
    end;
  end;
end;
like image 97
Koot33 Avatar answered Dec 24 '25 10:12

Koot33



Donate For Us

If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!