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)).
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'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
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.
I saw your tip about : TTouchKeyboard: send keystroke to other program
How can I send the keys to the other form in the same Delphi application?
And how can I call the form with the TTouchKeyboard? (Show, showModal, parameters?)
Thanks!
ShowModal is a bad idea... you focus the caller...
You can still use the same tip with the form which contains the keyboard, in order to stay disable...
Then, you can add a property with the handle of the form which should get the keystroke.
And finally, you hack the TTouchKeyboard to set the focus to the form with the handle you previously set...
For instance, your TTouchKeyboard hack could be like this:
type
TMyKeyboard = class(TTouchKeyboard)
protected
procedure WndProc(var Message: TMessage); override;
end;
type
TForm1 = class(TForm)
...
private
fHandleOfTheTargetForm: HWND;
public
property HandleOfTheTargetForm: HWND read fHandleOfTheTargetForm write fHandleOfTheTargetForm;
...
procedure TMyKeyboard.WndProc(var Message: TMessage);
begin
if (Assigned(Form1)) then
begin
if Form1.HandleOfTheTargetForm <> 0 then
begin
SetForegroundWindow(HandleOfTheTargetForm);
end;
end;
inherited;
end;
You can find a quick demo project here.
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.