How can I trigger an event when the mouse leaves my control? - delphi

How do I create an OnMouseLeave event?

Another alternative to the Andreas solution, is use the CM_MOUSELEAVE VCL Message which is already defined in delphi 7.
check this sample using a interposer class for the TButton
type
TButton = class(StdCtrls.TButton)
private
FOnMouseLeave: TNotifyEvent;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
protected
property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
end;
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
procedure FormCreate(Sender: TObject);
private
procedure ButtonMouseLeave(Sender: TObject);
public
end;
//handle the message and call the event handler
procedure TButton.CMMouseLeave(var Message: TMessage);
begin
if (Message.LParam = 0) and Assigned(FOnMouseLeave) then
FOnMouseLeave(Self);
end;
procedure TForm1.ButtonMouseLeave(Sender: TObject);
begin
//your code goes here
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
//assign the event
Button1.OnMouseLeave:=ButtonMouseLeave;
end;

You can tell Windows to post you a message, more specifically a WM_MOUSELEAVE message, when the mouse leaves the control. To do this, call the TrackMouseEvent function. In the TRACKMOUSEEVENT structure, specify the TME_LEAVE flag.
On request, some code:
When the control has been created, and the mouse is inside the client area of the control, tell Windows that you want to be notified about the mouse leaving the control:
procedure TMyControl.SetMouseEvent;
var
tme: TTrackMouseEvent;
begin
tme.cbSize := sizeof(tme);
tme.dwFlags := TME_LEAVE;
tme.hwndTrack := Self.Handle;
TrackMouseEvent(tme);
end;
Call this procedure when the control has been created and the mouse is inside the control. Now you just have to listen to the WM_MOUSELEAVE mesage. In your WndProc procedure (a protected member of the class), add a WM_MOUSELEAVE case.
procedure TMyControl.WndProc(var Message: TMessage);
begin
inherited;
case Message.Msg of
WM_MOUSELEAVE:
beep;
end;
end;
I think that Windows removes the notification request when a message has been created, so you have to rerequest the notification when you have recieved a message. You cannot call SetMouseEvent in the WndProc, because the mouse needs to be inside the client area of the control when you call TrackMouseEvent. I think you could place your SetMouseEvent inside the OnMouseMove of the control:
procedure TMyControl.WndProc(var Message: TMessage);
begin
inherited;
case Message.Msg of
WM_MOUSELEAVE:
beep;
WM_MOUSEMOVE:
SetMouseEvent;
end;
end;
I haven't tested the code above myself, because I use a newer version of Delphi, Delphi 2009, which does things like this behind the scenes (I think, because there is now a OnMouseLeave event in controls), and I think that will interfere.

Related

Can't Free caller component

I'm trying to free a component when i click it. So, i've written the simplest code i could imagine to achieve this: a procedure that frees it's sender. But on Delphi 7 (Tried on Delphi XE 10 and it worked with no errors) it sometimes throws an Access Violation or Abstract Error randomly. The easiest way to replicate this is to insert like 30 Buttons and assign an onclick procedure with the code below, then click them.
I've tried the two codes below, both on onclick:
procedure FreeMe(Sender: TObject);
begin
TButton(Sender).Free;
end;
or
procedure FreeMe(Sender: TObject);
begin
(Sender as TButton).Free;
end;
You need to delay the freeing until after the button's OnClick event handier has fully exited. It is important that the freeing happens when the object being freed is idle and not in the middle of processing anything.
One way to do that is to use PostMessage(), eg:
var
MyReleaseWnd: HWND;
procedure TMyMainForm.FormCreate(Sender: TObject);
begin
MyReleaseWnd := AllocateHWnd(MyReleaseWndProc);
end;
procedure TMyMainForm.FormDestroy(Sender: TObject);
begin
DeallocateHWnd(MyReleaseWnd);
end;
procedure TMyMainForm.MyReleaseWndProc(var Message: TMessage);
begin
if Message.Msg = CM_RELEASE then
TObject(Msg.LParam).Free
else
Message.Result := DefWindowProc(MyReleaseWnd, Message.Msg, Message.WParam, Message.LParam);
end;
procedure DelayFreeMe(Sender: TObject);
begin
PostMessage(MyReleaseWnd, CM_RELEASE, 0, LPARAM(Sender));
end;
Alternatively, in 10.2 Tokyo and later, you can use TThread.ForceQueue() instead:
procedure DelayFreeMe(Sender: TObject);
begin
TThread.ForceQueue(nil, Sender.Free);
end;
Either way, you can then do this:
procedure TSomeForm.ButtonClick(Sender: TObject);
begin
DelayFreeMe(Sender);
end;

Unintended tStringGrid.OnFixedCellClick firing behind tOpenDialog

I use Delphi Berlin on Windows 10. I need to use tOpenDialog on a tStringGrid based tForm.
When I double click a file which overlaps a fixed column or row on an open dialog onFixedCellClick event fires automatically right after the disapperance of the open dialog. In the following image the file is on the same position of fixed row which is the first line.
type
TForm1 = class(TForm)
StringGrid1: TStringGrid;
OpenDialog1: TOpenDialog;
procedure FormClick(Sender: TObject);
procedure StringGrid1FixedCellClick(Sender: TObject; ACol, ARow: Integer);
procedure FormCreate(Sender: TObject);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
StringGrid1.Options := StringGrid1.Options + [goFixedColClick, goFixedRowClick];
end;
procedure TForm1.FormClick(Sender: TObject);
begin
OpenDialog1.Execute;
end;
procedure TForm1.StringGrid1FixedCellClick(Sender: TObject; ACol, ARow: Integer);
begin
Caption := '';
end;
In most cases I can handle this by moving the dialog window or clicking the file once and clicking open button but I can't guarantee that other people who will use this would do that.
What is the reason and how can I solve this problem?
I believe this is a problem in how TCustomGrid triggers its OnFixedCellClick event on a mouse-up message (in its overriden MouseUp method) without checking if there was a corresponding mouse-down message (FHotTrackCell.Pressed). A quick fix (if you can copy and modify Vcl.Grids): on line 4564 in Berlin (in TCustomGrid.MouseUp method add another condition to check, leading to the call to FixedCellClick):
if ... and FHotTrackCell.Pressed then
FixedCellClick(Cell.X, Cell.Y);
In other words, don't call FixedCellClick if a mouse-up comes without a prior corresponding mouse-down.

Show custom control hint when disabled

I've written a custom control (TCustomControl) which shows the standard built-in hint on hovering. However, when the control is disabled, the hint does not show. But, the TSpeedButton does show a hint when it's disabled, so there must be a way I can do the same in my control.
What do I need to do to show hints when my control is disabled?
The standard hint mechanism is based on mouse messages. Controls derived from TWinControl (which includes TCustomControl) do not receive mouse messages when disabled, and the hint system internally ignores disabled windowed controls. TSpeedButton is derived from TGraphicControl instead of TWinControl, so it is not subject to those restrictions.
You need to enable the window handle in order to get a WM_MOUSEMOVE which starts showing the hint. This has some implications.
First, to enable the window handle (WinAPI), you need to delete the WS_DISABLED style from the window style, or use EnableWindow. This modification does not synchronize the VCL's Enabled property (unlike the other way around: setting the Enabled property dóes call EnableWindow), which is why this works.
But enabling the window handle lets all mouse messages through, so you have to block them and activate the hint manually on WM_MOUSEMOVE:
type
TMyControl = class(TCustomControl)
private
FDisabledHint: Boolean;
procedure CheckEnabled;
procedure SetDisabledHint(Value: Boolean);
procedure CMEnabledchanged(var Message: TMessage);
message CM_ENABLEDCHANGED;
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure SetParent(AParent: TWinControl); override;
procedure WndProc(var Message: TMessage); override;
published
property DisabledHint: Boolean read FDisabledHint write SetDisabledHint;
end;
{ TMyControl }
procedure TMyControl.CheckEnabled;
begin
if DisabledHint and HasParent and (not Enabled) and
not (csDesigning in ComponentState) then
EnableWindow(Handle, True);
end;
procedure TMyControl.CMEnabledchanged(var Message: TMessage);
begin
inherited;
CheckEnabled;
end;
procedure TMyControl.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
if DisabledHint and not Enabled then
Params.Style := Params.Style and (not WS_DISABLED);
end;
procedure TMyControl.SetDisabledHint(Value: Boolean);
begin
if FDisabledHint <> Value then
begin
FDisabledHint := Value;
CheckEnabled;
end;
end;
procedure TMyControl.SetParent(AParent: TWinControl);
begin
inherited SetParent(AParent);
CheckEnabled;
end;
procedure TMyControl.WndProc(var Message: TMessage);
begin
if not Enabled and DisabledHint and (Message.Msg = WM_MOUSEMOVE) then
Application.HintMouseMessage(Self, Message);
if Enabled or (Message.Msg < WM_MOUSEFIRST) or
(Message.Msg > WM_MOUSELAST) then
inherited WndProc(Message);
end;
I checked the working of the TabStop property, and this solution does not interfere with it. But beware of issues which I have not thought of yet.
(Besides, why a disabled TControl shows a hint is because it receives a CM_MOUSEENTER from WndProc of its parent, despite of that same parent blocking all other mouse input via IsControlMouseMsg to prevent the mouse events from firing.)
Actually you control's Winproc doesn't even get called when you control is disabled. Thy this small demo in order for understainding the message loop a bit better.
Place a TPanel on a form, and add a Double clickEvent To the form. Then try this code:
unit Unit39;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls;
type
TPanel = class(ExtCtrls.TPanel)
protected
procedure WndProc(var Message: TMessage); override;
end;
TForm39 = class(TForm)
Panel1: TPanel;
procedure FormDblClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form39: TForm39;
implementation
{$R *.dfm}
{ TPanel }
procedure TPanel.WndProc(var Message: TMessage);
begin
inherited;
Application.MainForm.Caption := FloatToStr(now);
end;
procedure TForm39.FormDblClick(Sender: TObject);
begin
Panel1.Enabled := not Panel1.Enabled;
end;
end.
YES! Correct: Ugly hack and violation of ALL designpatterns but with this small example you can see how the message loop works, and it is a very simple way to test some thing.
PS: I placed this as an answer because you can not format you text in comment :D

How do I catch certain events of a form from outside the form?

I'm working on something which will require monitoring of many forms. From outside the form, and without putting any code inside the form, I need to somehow capture events from these forms, most likely in the form of windows messages. But how would you capture windows messages from outside the class it's related to?
My project has an object which wraps each form it is monitoring, and I presume this handling will go in this object. Essentially, when I create a form I want to monitor, I create a corresponding object which in turn gets added to a list of all created forms. Most importantly, when that form is closed, I have to know so I can remove this form's wrapper object from the list.
These events include:
Minimize
Maximize
Restore
Close
Focus in/out
What I DON'T want:
Any code inside any forms or form units for this handling
Inheriting the forms from any custom base form
Using the form's events such as OnClose because they will be used for other purposes
What I DO want:
Handling of windows messages for these events
Any tips on how to get windows messages from outside the class
Which windows messages I need to listen for
Question re-written with same information but different approach
You need to listen for particular windows messages being delivered to the form. The easiest way to do this is to assign the WindowProc property of the form. Remember to keep a hold of the previous value of WindowProc and call it from your replacement.
In your wrapper object declare a field like this:
FOriginalWindowProc: TWndMethod;
Then in the wrapper's constructor do this:
FOriginalWindowProc := Form.WindowProc;
Form.WindowProc := NewWindowProc;
Finally, implement the replacement window procedure:
procedure TFormWrapper.NewWindowProc(var Message: TMessage);
begin
//test for and respond to the messages of interest
FOriginalWindowProc(Message);
end;
Here's a more complete example of the solution that David Provided:
private
{ Private declarations }
SaveProc : TWndMethod;
procedure CommonWindowProc(var Message: TMessage);
...
procedure TForm1.Button1Click(Sender: TObject);
var
f : tForm2;
begin
f := tForm2.Create(nil);
SaveProc := f.WindowProc;
f.WindowProc := CommonWindowProc;
f.Show;
end;
procedure TForm1.CommonWindowProc(var Message: TMessage);
begin
case Message.Msg of
WM_SIZE : Memo1.Lines.Add('Resizing');
WM_CLOSE : Memo1.Lines.Add('Closing');
CM_MOUSEENTER : Memo1.Lines.Add('Mouse enter form');
CM_MOUSELEAVE : Memo1.Lines.Add('Mouse leaving form');
// all other messages will be available as needed
end;
SaveProc(Message); // Call the original handler for the other form
end;
A better solution than trying to work outside of the form would be to make every form descend from a common base form that implements the functionality. The form event handlers are exactly the right place to add this code but you'd write it all in the ancestor form. Any descendant form could still use the form events and as long as they always call inherited somewhere in the event handler the ancestor code would still execute.
Another option is create TApplicationEvents and assign a handler to OnMessage event. Once if it fired, use the FindControl function and Msg.hWnd to check if it is the tform type and do what ever you want without hookin
Using Windows Messages can really attain a fine granularity (Yes, its part of your requirements!) but in some user cases where relying just on the VCL Event Framework suffices, a similar solution can be suggested:
unit Host;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
THostForm = class(TForm)
Memo1: TMemo;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
FFormResize: TNotifyEvent;
FFormActivate: TNotifyEvent;
FFormDeactivate: TNotifyEvent;
FFormDestroy: TNotifyEvent;
procedure _FormResize(Sender: TObject);
procedure _FormActivate(Sender: TObject);
procedure _FormDeactivate(Sender: TObject);
procedure InternalEventHandlerInit(const AForm:TForm);
public
procedure Log(const Msg:string);
procedure Logln(const Msg:string);
end;
var
HostForm: THostForm;
implementation
{$R *.dfm}
procedure THostForm.Button1Click(Sender: TObject);
var
frm: TForm;
begin
frm := TForm.Create(nil);
frm.Name := 'EmbeddedForm';
frm.Caption := 'Embedded Form';
//
InternalEventHandlerInit(frm);
//
Logln('<'+frm.Caption+'> created.');
//
frm.Show;
end;
procedure THostForm.InternalEventHandlerInit(const AForm: TForm);
begin
FFormResize := AForm.OnResize;
AForm.OnResize := _FormResize;
//
FFormActivate := AForm.OnActivate;
AForm.OnActivate := _FormActivate;
//
FFormDeactivate := AForm.OnDeactivate;
AForm.OnDeactivate := _FormDeactivate;
end;
procedure THostForm.Log(const Msg: string);
begin
Memo1.Lines.Add(Msg);
end;
procedure THostForm.Logln(const Msg: string);
begin
Memo1.Lines.Add(Msg);
Memo1.Lines.Add('');
end;
procedure THostForm._FormActivate(Sender: TObject);
begin
Log('Before OnActivate <'+(Sender as TCustomForm).Caption+'>');
//
if Assigned(FFormActivate) then
FFormActivate(Sender) // <<<
else
Log('No OnActivate Event Handler attached in <'+(Sender as TCustomForm).Caption+'>');
//
Logln('After OnActivate <'+(Sender as TCustomForm).Caption+'>');
end;
procedure THostForm._FormDeactivate(Sender: TObject);
begin
Log('Before OnDeactivate <'+(Sender as TCustomForm).Caption+'>');
//
if Assigned(FFormDeactivate) then
FFormDeactivate(Sender)
else
Log('No OnDeActivate Event Handler attached in <'+(Sender as TCustomForm).Caption+'>');
//
Logln('After OnDeactivate <'+(Sender as TCustomForm).Caption+'>');
end;
procedure THostForm._FormResize(Sender: TObject);
begin
Log('Before OnResize <'+(Sender as TCustomForm).Caption+'>');
//
if Assigned(FFormResize) then
FFormResize(Sender)
else
Log('No OnResize Event Handler attached in <'+(Sender as TCustomForm).Caption+'>');
//
Logln('After OnResize <'+(Sender as TCustomForm).Caption+'>');
end;
end.

TListView scroll event

Does the TListView control have an event that will fire whenever the control is scrolled?
I would prefer not to have to sub-class the TListView control.
This works perfectly, but might violate the constraints of your question.
In the interface section of the unit containing the form that use the TListView (prior to the TForm declaration), add
type
TListView = class(ComCtrls.TListView)
protected
procedure WndProc(var Message: TMessage); override;
end;
Then, in the implementation section of the same unit, define
procedure TListView.WndProc(var Message: TMessage);
begin
inherited;
case Message.Msg of
WM_HSCROLL, WM_VSCROLL: beep;
end;
end;
You can subclass a window without writing a descendant class, which is useful when you expect the changed behavior to be a one-off requirement. Write a TWndMethod function like in Andreas's answer, but write it in whatever class you want, such as the form that owns the list view. Assign it to the list-view control's WindowProc property. Before you do that, store the property's previous value so you can defer all other messages to it.
type
TNanikForm = class(TForm)
ListView: TListView;
private
FPrevListViewProc: TWndMethod;
procedure ListViewWndProc(var Msg: TMessage);
public
procedure Loaded; override;
end;
procedure TNanikForm.ListViewWndProc(var Msg: TMessage);
begin
case Msg.Message of
wm_VScroll: ;
else FPrevListViewProc(Msg);
end;
end;
procedure TNanikForm.Loaded;
begin
inherited;
FPrevListViewProc := ListView.WindowProc;
ListView.WindowProc := ListViewWndProc;
end;
Or if you want to trap just vertical scroll event, you can use this. Code is almost the same as Andreas posted ...
type
TListView = class(ComCtrls.TListView)
protected
procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
end;
procedure TListView.WMVScroll(var Message: TWMVScroll);
begin
inherited;
Beep;
end;
The all answer is fine :-), but I don't wont to create new child of class. Thanks everyone for your help :-)!
My resolution: I use component (in Delphi 7) ApplicationEvents and I check change of ScrollBar position (GetScrollPos(ListView.Handle, SB_VERT)).

Resources