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
Related
I want to update the font color of all my edit when they are set to readonly. For this I update TCustomEdit like this:
TMyCustomEdit = class(TCustomEdit)
private
procedure EMSetReadOnly (var Message: TMessage); message
end;
procedure TMyCustomEdit.EMSetReadOnly (var Message: TMessage);
begin
inherited;
font.Color := clred;
end;
But i do not understand why this not work :(
Ideally i want that my readonly Edit to have the same design than a disabled Tedit
Well, for starters, your code is incomplete, it should look more like this instead:
type
TMyCustomEdit = class(TCustomEdit)
private
procedure EMSetReadOnly(var Message: TMessage); message EM_SETREADONLY;
procedure UpdateFont;
protected
procedure CreateWnd; override;
end;
procedure TMyCustomEdit.EMSetReadOnly(var Message: TMessage);
begin
inherited;
UpdateFont;
end;
procedure TMyCustomEdit.CreateWnd;
begin
inherited;
UpdateFont;
end;
procedure TMyCustomEdit.UpdateFont;
begin
if (GetWindowLongPtr(Handle, GWL_STYLE) and ES_READONLY) <> 0 then
Font.Color := clRed
else
Font.Color := clWindowText;
end;
With that said, to work correctly at runtime, you need to make sure that all of your Edit objects are actually using this class and not the standard TEdit class. If you want to do this at design-time, you would have to put this class into a package and install it into the IDE.
A simpler way is to just turn this into an interposer class instead:
type
TEdit = class(Vcl.StdCtls.TEdit)
... same code as above ...
end;
Place this class declaration above your TForm class declaration. Or in a separate unit that is included in your uses clause after the Vcl.StdCtrls unit. Either way, the DFM streaming system will use the last declared definition of TEdit for all TEdit objects in the TForm. No IDE installation required.
I have a Delphi 2007 project that has run fine on Windos XP, Vista and "7" for years. It was an upgrade from Delphi 5 thus "MainFormOnTaskBar" was "false" by default (I never changed it in DPR). In this scenario, the system-wide hot key worked "system-wide" with following code in main form's OnCreate event handler.
HotKey_xyz := GlobalAddAtom('Hotkey_xyz');
if NOT RegisterHotKey(Self.Handle, HotKey_xyz, MOD_CONTROL, VK_F12) then
ShowMessage('Unable to register Control-F12 as system-wide hot key') ;
(I have GlobalDeleteAtom() and UnregisterHotKey() in Form.OnDestroy as expected.)
Now, I need a Form to show its own button on Taskbar, so I set "Application.MainFormOnTaskBar := True" in DPR. This works as expected. However, this has the side-effect that Control-F12 does NOT work system-wide, it works ONLY IF my application has focus (so, it is NOT "system-wide" anymore.)
I have extensively searched the 'Net have found many articles regarding how/why "MainFormOnTaskBar" affects certain subform/modal form behaviors. However, I have found nothing regarding its effect on a "System-Wide Hot Key" issue that I describe above. I have tested and retested my application with MainFormOnTaskBar set to true and false while all else remains exactly the same. I can positively verify that the above described issue with System-wide hot key relates to MainFormOnTaskBar flag.
I will greatly appreciate any guidance regarding a work-around. I do need BOTH - a system-wide hot key AND a form with its own button on taskbar.
Thank You very much.
TApplication.MainFormOnTaskbar has no effect on system-wide hotkeys at all. I can positively confirm that. I am able to receive WM_HOTKEY messages regardless of what MainFormOnTaskbar is set to, regardless of whether the app is focused or not, etc. So whatever you are seeing is not what you think is happening.
Most likely, the Form's Handle is simply being recreated behind your back after you have called RegisterHotKey(), so you lose the HWND that would receive the WM_HOTKEY messages. Instead of using the OnCreate event, you should override the Form's CreateWindowHandle() and DestroyWindowHandle() methods instead to ensure the hot key is always registered for the Form's current HWND no matter what happens to it (you should always do that whenever you tie any kind of data to the Form's Handle), eg:
type
TForm1 = class(TForm)
private
HotKey_xyz: WORD;
procedure WMHotKey(var Message: TMessage); message WM_HOTKEY;
protected
procedure CreateWindowHandle(const Params: TCreateParams); override;
procedure DestroyWindowHandle; override;
end;
procedure TForm1.CreateWindowHandle(const Params: TCreateParams);
begin
inherited;
HotKey_xyz := GlobalAddAtom('Hotkey_xyz');
if HotKey_xyz <> 0 then
RegisterHotKey(Self.Handle, HotKey_xyz, MOD_CONTROL, VK_F12);
end;
procedure TForm1.DestroyWindowHandle(const Params: TCreateParams);
begin
if HotKey_xyz <> 0 then
begin
UnregisterHotKey(Self.Handle, HotKey_xyz);
GlobalDeleteAtom(HotKey_xyz);
HotKey_xyz := 0;
end;
inherited;
end;
procedure TForm1.WMHotKey(var Message: TMessage);
begin
...
end;
A better option is to use AllocateHWnd() to allocate a separate dedicated HWND just for handling the hot key messages (then you can use the OnCreate and OnDestroy events again), eg:
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
HotKey_xyz: WORD;
HotKeyWnd: HWND;
procedure HotKeyWndProc(var Message: TMessage);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
HotKeyWnd := AllocateHwnd(HotKeyWndProc);
HotKey_xyz := GlobalAddAtom('Hotkey_xyz');
if HotKey_xyz <> 0 then
RegisterHotKey(HotKeyWnd, HotKey_xyz, MOD_CONTROL, VK_F12);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if HotKey_xyz <> 0 then
begin
UnregisterHotKey(HotKeyWnd, HotKey_xyz);
GlobalDeleteAtom(HotKey_xyz);
HotKey_xyz := 0;
end;
if HotKeyWnd <> 0 then
begin
DeallocateHWnd(HotKeyWnd);
HotKeyWnd := 0;
end;
end;
procedure TForm1.HotKeyWndProc(var Message: TMessage);
begin
if Message.Msg = WM_HOTKEY then
begin
...
end else
Message.Result := DefWindowProc(HotKeyWnd, Message.Msg, Message.WParam, Message.LParam);
end;
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.
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.
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)).