There is a TFrame descendant class as follows:
TCustomHistoryFrame = class(TFrame)
tbMainFunction: TToolBar;
// there's more, of course, but that is irrelevant to the question
end;
I noticed, that when I set Enabled property of this frame to False, its component tbMainFunction won't get (visually) disabled.
My first idea was to override virtual method TControl.SetEnabled. Looking at its implementation, I saw that it performs control message CM_ENABLEDCHANGED when the value of actually differs.
I am not sure on how to apply the frame's Enabled state to the toolbar the right way.
What would be the common way to do? As this question would be primarily opinion based, let me rephrase it:
What advantages and disadvantages are there for either overriding SetEnabled or handling CM_ENABLEDCHANGED?
Things, I thought of myself:
override SetEnabled:
I would have to recheck, whether the new value differs from the old value. That would be a redundancy. (Which would have no significant influence on performance, but - call me a hair-splitter - smells to me.)
handling CM_ENABLEDCHANGED:
How do I sustain inherited code for this message? There are implementations for this message (at least) in TControl and TWinControl. Would they still be executed, if I handle the message in my class TCustomHistoryFrame?
Handling CM_ENABLEDCHANGED is the correct solution. Such CM_... messages are specifically designed to allow descendant classes to react to changes to properties that are declared in base classes.
For example:
TCustomHistoryFrame = class(TFrame)
tbMainFunction: TToolBar;
private
procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
end;
procedure TCustomHistoryFrame.CMEnabledChanged(var Message: TMessage);
begin
inherited;
tbMainFunction.Enabled := Enabled;
end;
Alternatively:
TCustomHistoryFrame = class(TFrame)
tbMainFunction: TToolBar;
protected
procedure WndProc(var Message: TMessage); override;
end;
procedure TCustomHistoryFrame.WndProc(var Message: TMessage);
begin
inherited;
if Message.Msg = CM_ENABLEDCHANGED then
tbMainFunction.Enabled := Enabled;
end;
Related
One day ago I had started to rewrite one of my old components and I decided to improve its readability.
My component is a typical TWinControl that has overridden WndProc to handle a lot of messages of my own. There are so many code for each message and it became a problem for me to read code.
So, looking for a solution to improve code inside WndProc, I have organized these large pieces of code in procedures that called each time when appropriate message has delivered in WndProc. That's how it looks now:
procedure TMyControl.WndProc(var Message: TMessage);
begin
case Message.Msg of
WM_WINDOWPOSCHANGED:
WMWINDOWPOSCHANGED(Message);
WM_DESTROY:
WMDESTROY(Message);
WM_STYLECHANGED:
WMSTYLECHANGED(Message);
// lots of the same procedures for Windows messages
// ...
MM_FOLDER_CHANGED:
MMFOLDERCHANGED(Message);
MM_DIRECTORY_CHANGED:
MMDIRECTORYCHANGED(Message);
// lots of the same procedures for my own messages
// ...
else
Inherited WndProc(Message);
end;
end;
Unfortunately Inherited word in these procedures doesn't work anymore!
Important note: in some of WM_XXX messages I didn't call Inherited to perform my own handling of such message, so code shown below will break down my efforts to implement some features.
procedure TMyControl.WndProc(var Message: TMessage);
begin
Inherited WndProc(Message);
case Message.Msg of
WM_WINDOWPOSCHANGED:
WMWINDOWPOSCHANGED(Message);
// further messages
// ...
end;
end;
I also want to avoid inserting Inherited after each message-ID as shown below, because it looks awful and I think there is exists more elegant way to override WndProc.
procedure TMyControl.WndProc(var Message: TMessage);
begin
case Message.Msg of
WM_WINDOWPOSCHANGED:
begin
Inherited WndProc(Message);
WMWINDOWPOSCHANGED(Message);
end;
// further messages
// ...
end;
end;
So my question is:
how to properly override WndProc to have an ability to use code grouped in procedures and to be able to call for original window procedure only for some messages?
As RM's answer stated, your message handling methods can call inherited WndProc(Message) instead of just inherited, and that will work fine.
However, by introducing methods with the same names as the messages they are processing, you are exposing knowledge of the specific messages you are processing. So you may find it easier to just use Message Methods instead of overriding WndProc, eg:
type
TMyControl = class(...)
private
procedure WMWindowPosChanged(var Message: TMessage); message WM_WINDOWPOSCHANGED;
procedure WMDestroy(var Message: TMessage); message WM_DESTROY;
procedure WMStyleChanged(var Message: TMessage); message WM_STYLECHANGED;
// and so on ...
end;
Your message methods can then call inherited (or not) as needed, eg:
procedure TMyControl.WMWindowPosChanged(var Message: TMessage);
begin
inherited;
//...
end;
Calling inherited WndProc from WMWINDOWPOSCHANGED will call the inherited one. So you can do it like this:
procedure WMWINDOWPOSCHANGED(var Message: TMessage)
begin
// call inherited WndProc if you need to
inherited WndProc(Message);
.. do you own processing
end;
In one old project, which I was instructed to develop, there is a field of type TScrollBox.
FScroll : TScrollBox;
To be able to handle the events of navigation buttons, the class must contain a WM_GETDLGCODE message handler. So I created a new class:
TScrollBoxArrowBtn = class(TScrollBox)
protected
procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
end;
Implementation
procedure TScrollBoxArrowBtn.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
Message.Result := DLGC_WANTARROWS;
end;
And replaced the TScrollBox type with TScrollBoxArrowBtn.
FScroll : TScrollBoxArrowBtn;
The component began to respond to pressing the arrow button. But the copy, delete, SelectAll methods stopped working. This happened because the previous developer added to the verification methods like this:
"VariableName".ClassType = TScrollBox
I replaced them for verification:
"VariableName" is TScrollBox
After this methods of editing began to work. But I'm not sure that such a test will not be applied elsewhere in the project. So I decided to leave
FScroll : TScrollBox;
And made TScrollBoxArrowBtn an helper class:
TScrollBoxArrowBtn = class helper for TScrollBox
protected
procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
end;
Unfortunately this method does not work. Verifications like "VariableName".ClassType = TScrollBox began to work perfectly, but project stopped responding to events arrow button. What did I do wrong?
I'm convinced that my version of IDE supports helper methods.
I did not find the answer specifically about the message methods in the helpers classes, but I found a way to solve my problem. In addition, I learned about many other bad features of the helper class, which finally convinced me to abandon their use. So my answer is - do not use the class helpers. At this time this is a very unstable tool. Perhaps in the future it will be improved.
Now about my decision. As I feared, the problem of checking the type of the following kind:
"VariableName".ClassType = TScrollBox
again appeared when merging the previously created branches. So I decided to replace the TScrollBox window procedure. I added field in the TScrollBox-field container class and I added a new window procedure for TScrollBox-field in the container class:
TCADParamsGroupBlockBaseScheme = class (TCADGroupBlockParams)
.....................................................
protected
Old_FScroll_WindowProc : TWndMethod;
procedure New_FScroll_WindowProc(var Message: TMessage);
.....................................................
end;
implementation
procedure TCADParamsGroupBlockBaseScheme.New_FScroll_WindowProc(var Message:
TMessage);
begin
//Для обработки событий нажатий Key_Up/Down/Left/Right в DoKeyDown
if Message.Msg = WM_GETDLGCODE then
Message.Result := DLGC_WANTARROWS
else Old_FScroll_WindowProc(Message);
end;
And in the constructor of the container class, I saved the pointer to the old TScrollBox-field window procedure and assigned it a new window procedure:
constructor TCADParamsGroupBlockBaseScheme.Create(const AOwner: TWinControl);
begin
...........................................
FScroll := TScrollBox.Create(FHost.Owner);
Old_FScroll_WindowProc := FScroll.WindowProc;
FScroll.WindowProc := New_FScroll_WindowProc;
............................................
end;
I want use messagesin my program and i've a question: Can I use messages in a class procedure or Can I use messages in a procedure without class?
Here is my code:
const
WM_CUSTOM_TCP_CLIENT = WM_USER + 10;
type
TFeedbackEvent = class
public
class procedure feedback(var msg: TMessage); message WM_CUSTOM_TCP_CLIENT;
end;
The Delphi returns the following message:
[Error] unit.pas(33): Invalid message parameter list
Thank you very much.
There is a very nice article on the topic: Handling Messages in Delphi 6. This is a must read.
Handling or processing a message means that your application responds
in some manner to a Windows message. In a standard Windows
application, message handling is performed in each window procedure.
By internalizing the window procedure, however, Delphi makes it much
easier to handle individual messages; instead of having one procedure
that handles all messages, each message has its own procedure. Three
requirements must be met for a procedure to be a message-handling
procedure:
The procedure must be a method of an object.
The procedure must take one var parameter of a TMessage or other message-specific record type.
The procedure must use the message directive followed by the constant value of the message you want to process.
As you can read in the article, the procedure must be a method of an object, not a class. So you cannot just use message handlers in a class procedure.
A possible workaround to handle messages in a class instance (also in object instance or window-less applications), is to manually create window handle via AllocateHWND, and process messages yourself via a WndProc procedure.
There is a good example on this in delphi.about.com: Sending messages to non-windowed applications (Page 2):
The following sample is a version of the above example, modified to work with class method. (If using class method is not really required, use original example from the link above instead):
First, you need to declare a window handle field and a WndProc procedure:
TFeedbackEvent = class
private
FHandle: HWND;
protected
class procedure ClassWndProc(var msg: TMessage);
end;
procedure WndProc(var msg: TMessage);
Then, process the messages manually:
procedure WndProc(var msg: TMessage);
begin
TFeedbackEvent.ClassWndProc(msg);
end;
procedure TFeedbackEvent.ClassWndProc(var msg: TMessage);
begin
if msg.Msg = WM_CUSTOM_TCP_CLIENT then
// TODO: Handle your message
else
// Let default handler process other messages
msg.Result := DefWindowProc(FHandle, msg.Msg, msg.wParam, msg.lParam);
end;
Finally, at the end of the file, declare initialization and finalization section to create/destroy the handle:
initialization
FHandle := AllocateHWND(WndProc);
finalization
DeallocateHWnd(FHandle);
Of course, this is not the recommended way to do this (especially watch for problems with initialization/finalization), it was just an example to show that it is possible.
Unless you have some very strange requirement to use class method, its better to use regular class method and object constructor and destructor instead initialization and finalization sections (as shown in Sending messages to non-windowed applications (Page 2)).
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
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)).