Where to free dynamically allocated TFrame's components' objects? - delphi

I have a form containing a TFrame. The TFrame contains a ComboBox that is dynamically populated. Each ComboBox entry has an associated object. By the time the overridden destructor for the TFrame is called, the Items in the ComboBox have already been cleared without freeing their associated objects. This happens whether I drop the ComboBox on the form in designer view, or dynamically create it in code with either nil or the TFrame as its owner. I currently use the OnDestroy event of the containing TForm to call a clean-up procedure of the contained TFrame.
Is there a better way that would not need an explicit procedure call by the TFrame's container? Where ideally should the objects added dynamically to the ComboBox be freed?

You say that when the destructor for the TFrame is called, the Items of the ComboBox have already been cleared. That's not the case, ComboBox items are never cleared. When Items is destroyed by the ComboBox, they've got a count of only 0.
When you exit your application and the VCL destroys the form containing the frame and the ComboBox, the native ComboBox control is also destroyed by the OS since it is placed in a window being destroyed. When you later access the items to be able to free your objects in the frame destructor, the VCL have to recreate a native ComboBox control, having an item count of 0.
The solution I'd propose is easy. Don't leave freeing your frame to the framework, instead, destroy your frame in the OnDestroy event of your form. That would be before the underlying window of the form is destroyed, hence you'll be able to access your objects.
form unit
procedure TMyForm.FormDestroy(Sender: TObject);
begin
MyFrame.Free;
end;
frame unit
destructor TMyFrame.Destroy;
var
i: Integer;
begin
for i := 0 to ComboBox1.Items.Count - 1 do
ComboBox1.Items.Objects[i].Free;
inherited;
end;

You could utilize the TFrame's WM_DESTROY handler like this:
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, Forms, StdCtrls;
type
TFrame1 = class(TFrame)
ComboBox1: TComboBox;
private
procedure WMDestroy(var Msg: TWMDestroy); message WM_DESTROY;
procedure FreeComboBoxItems;
public
constructor Create(AOwner: TComponent); override;
end;
implementation
{$R *.dfm}
constructor TFrame1.Create(AOwner: TComponent);
begin
inherited;
// Add some object items to the ComboBox
ComboBox1.AddItem('a', TButton.Create(nil));
ComboBox1.AddItem('b', TMemoryStream.Create);
ComboBox1.AddItem('c', TList.Create);
end;
procedure TFrame1.WMDestroy(var Msg: TWMDestroy);
begin
// Make sure the TFrame is actually destroying - not recreated
if (csDestroying in ComponentState) then
FreeComboBoxItems;
inherited;
end;
procedure TFrame1.FreeComboBoxItems;
var
I: Integer;
begin
OutputDebugString('TFrame1.FreeComboBoxItems');
with Self.ComboBox1 do
for I := 0 to Items.Count - 1 do
begin
OutputDebugString(PChar(Items.Objects[I].ClassName + '.Free'));
Items.Objects[I].Free;
end;
end;
end.
Another option is to create a Base ancestor TAppBaseForm class and a TAppBaseFrame for the entire application, and derive all your Forms as TAppBaseForm and all Frames as TAppBaseFrame.
This way the TAppBaseForm could notify all it's child TAppBaseFrame that the owner Form is destroyed on TAppBaseForm.FormDestroy event handler. At that point the ComboBox items are still valid (as described by Sertac Akyuz's answer).

Your question isn't really usefull, because - generally speaking - it is discouraged to store data (or objects in your case) in a GUI control. See also David's comment on how to change your design.
What makes the question kind of interresting to answer though is the difference between the combo box being a child of a form directly and being a child of another child of the form (your frame in this case). Apparently, the combo box items are destroyed before the destructor of that frame is called. Obvious alternatives to explore are then: overriding Frame.BeforeDestruction, overriding Frame.DestroyWindowHandle, overriding Frame.DestroyWnd, or catching WM_DESTROY in an overridden Frame.WndProc, but none of them is called before the items are already gone.
The next thing to try is to repeat this for the combo box. It turns out that when WM_DESTROY arrives at the combo box that the items are still there. However, beware of catching that message ónly when the control really is being destroyed, because the VCL might recreate a combo box frequently. Implement it using an interposing class for TComboBox, as follows:
unit Unit2;
interface
uses
Windows, Messages, Classes, Controls, Forms, StdCtrls;
type
TComboBox = class(StdCtrls.TComboBox)
protected
procedure WndProc(var Message: TMessage); override;
end;
TFrame1 = class(TFrame)
ComboBox1: TComboBox;
end;
implementation
{$R *.dfm}
{ TComboBox }
procedure TComboBox.WndProc(var Message: TMessage);
var
I: Integer;
begin
if (Message.Msg = WM_DESTROY) and (csDestroying in ComponentState) then
for I := 0 to Items.Count - 1 do
Items.Objects[I].Free;
inherited WndProc(Message);
end;
end.
Now, to answer your question: "Is this a better way?"
Yes it is, because it offers assurance of the object's destruction at the frame's level. In other words: you don't have to remember to deal with this for every instance seperately.
And no it is not, because this solution requires that the objects in the combo box are allowed to be freed in whatever circumstance which restricts usage to an unnecessary extra boundary.
So, is this answer usefull? Well, if it prevents you from using your current approach, then it is.
Besides, I also found another alternative by setting the frame's Parent property to nil in the containing form OnDestroy handler:
procedure TForm2.FormDestroy(Sender: TObject);
begin
Frame1.Parent := nil;
end;
In this case, you can safely destroy the objects stored in the combo box within the frame's destructor. But this solution is even worse than your current one, because it is not descriptive. Then Frame1.FreeComboObjects is much better.

freeing Combobox.Items.Objects in destructor is too late.
so, according to previous answers it is better and safe to do that this way:
procedure TMyFrame.ClearCBObjects;
var
i: Integer;
begin
for i := 0 to ComboBox1.Items.Count - 1 do
ComboBox1.Items.Objects[i].Free;
end;
destructor TMyFrame.Destroy;
begin
//Free none Component objects
inherited;
end;
destructor TMyForm.Destroy;
begin
MyFrame.ClearCBObjects;
inherited;
end;

Related

How to initialize a custom control?

I want to create my own custom control. Let's say I want to initialize its graphic properties. Obviously I cannot do that in Create because a canvas/handle is not YET allocated.
The same if my custom control contains a subcomponent (and I also set its visual properties).
There are quite several places on SO that discuss the creation of a custom control. They don't really agree on it.
AfterConstruction is out of question because the handle is not ready yet.
CreateWnd seem ok but it actually can be quite problematic as it can be called more than once (for example when you apply a new skin to the program). Probably, some boolean variable should be used to check if CreateWnd was called more than once.
SetParent has the same issue: if you change the parent of your custom control, whatever code you put in its SetParent will be executed again. A bool variable should fix the problem.
Principles
First al all, most of the visual properties of a control do not require the control to have a valid window handle in order to be set. It is a false assumption that they do.
Once the object that constitutes a control is created, i.e. the constructor has been executed, normally all (visual) properties like size, position, font, color, alignment, etc. can be set. Or they should be able to, preferably. For sub controls, also the Parent ideally must be set as soon as the constructor has run. For the component itself, that constructor would be the inherited constructor during its own constructor.
The reason this works is that all these kind of properties are stored within the fields of the Delphi object itself: they are not immediately passed to the Windows API. That happens in CreateWnd but no sooner than when all necessary parent window handles are resolved and assigned.
So the short answer is: the initial setup of a custom component is done in its constructor, because it is the only routine that runs once.
But the question (unintentionally) touches a wide range of topics on component building, because the complexity of an initial setup of a control depends entirely on the type of control and the properties that are to be set.
Example
Consider writing this (useless yet illustrative) component that consists of a panel with a combo box aligned on top of it. The panel should initially have: no caption, a custom height and a silver background. The combo box should have: a custom font size and a 'picklist' style.
type
TMyPanel = class(TPanel)
private
FComboBox: TComboBox;
public
constructor Create(AOwner: TComponent); override;
end;
constructor TMyPanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Color := clSilver;
ShowCaption := False;
Height := 100;
FComboBox := TComboBox.Create(Self);
FComboBox.Parent := Self;
FComboBox.Align := alTop;
FComboBox.Style := csDropDownList;
FComboBox.Font.Size := 12;
end;
Framework conformity
A component writer could now consider it done, but it is not. He/she has the responsibility to write components properly as described by the comprehensive Delphi Component Writer's Guide.
Note that no less then four properties (indicated bold in the object inspector) are needlessly stored in the DFM because of an incorrect designtime component definition. Although invisible, the caption property still reads MyPanel1, which is against te requirements. This can be solved by removing the applicable control style. The ShowCaption, Color and ParentBackground properties lack a proper default property value.
Note too that all default properties of TPanel are present, but you might want some not te be, especially the ShowCaption property. This can be prevented by descending from the right class type. The standard controls in the Delphi framework mostly offer a custom variant, e.g. TCustomEdit instead of TEdit that are there for exactly this reason.
Our example compound control that is rid of these issues looks as follows:
type
TMyPanel = class(TCustomPanel)
private
FComboBox: TComboBox;
public
constructor Create(AOwner: TComponent); override;
published
property Color default clSilver;
property ParentBackground default False;
end;
constructor TMyPanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Color := clSilver;
ControlStyle := ControlStyle - [csSetCaption];
Height := 100;
FComboBox := TComboBox.Create(Self);
FComboBox.Parent := Self;
FComboBox.Align := alTop;
FComboBox.Style := csDropDownList;
FComboBox.Font.Size := 12;
end;
Of course, other implications due to setting up a component are possible.
Exceptions
Unfortunately there áre properties that require a control's valid window handle, because the control stores its value in Windows' native control. Take the Items property of the combo box above for example. Consider a deisgn time requirement of it been filled with some predefined text items. You then should need to override CreateWnd and add the text items the first time that it is called.
Sometimes the initial setup of a control depends on other controls. At design time you don't (want to) have control over the order in which all controls are read. In such case, you need to override Loaded. Consider a design time requirement of adding all menu-items from the PopupMenu property, if any, to the Items property of the combo box.
The example above, extended with these new features, results finally in:
type
TMyPanel = class(TCustomPanel)
private
FInitialized: Boolean;
FComboBox: TComboBox;
procedure Initialize;
protected
procedure CreateWnd; override;
procedure Loaded; override;
public
constructor Create(AOwner: TComponent); override;
published
property Color default clSilver;
property ParentBackground default False;
property PopupMenu;
end;
constructor TMyPanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Color := clSilver;
ControlStyle := ControlStyle - [csSetCaption];
Height := 100;
FComboBox := TComboBox.Create(Self);
FComboBox.Parent := Self;
FComboBox.Align := alTop;
FComboBox.Style := csDropDownList;
FComboBox.Font.Size := 12;
end;
procedure TMyPanel.CreateWnd;
begin
inherited CreateWnd;
if not FInitialized then
Initialize;
end;
procedure TMyPanel.Initialize;
var
I: Integer;
begin
if HandleAllocated then
begin
if Assigned(PopupMenu) then
for I := 0 to PopupMenu.Items.Count - 1 do
FComboBox.Items.Add(PopupMenu.Items[I].Caption)
else
FComboBox.Items.Add('Test');
FInitialized := True;
end;
end;
procedure TMyPanel.Loaded;
begin
inherited Loaded;
Initialize;
end;
It is also possible that the component depends in some way on its parent. Then override SetParent, but also remember that any dependency on (properties of) its parent likely indicates a design issue which might require re-evaluation.
And surely there are other kind of dependencies imaginable. They then would require special handling somewhere else in the component code. Or another question here on SO. 😉
So, I did this test that shows the creation order.
UNIT cvTester;
{--------------------------------------------------------------------------------------------------
This file tests the initialization order of a custom control.
--------------------------------------------------------------------------------------------------}
INTERFACE
{$WARN GARBAGE OFF} { Silent the: 'W1011 Text after final END' warning }
USES
System.SysUtils, System.Classes, vcl.Controls, vcl.Forms, Vcl.StdCtrls, Vcl.ExtCtrls;
TYPE
TCustomCtrlTest = class(TPanel)
private
protected
Initialized: boolean;
Sub: TButton;
public
constructor Create(AOwner: TComponent); override;
procedure Loaded; override;
procedure AfterConstruction; override;
procedure CreateWnd; override;
procedure CreateWindowHandle(const Params: TCreateParams); override;
procedure WriteToString(s: string);
procedure SetParent(AParent: TWinControl); override;
published
end;
procedure Register;
IMPLEMENTATION
USES System.IOUtils;
procedure Register;
begin
RegisterComponents('Mine', [TCustomCtrlTest]);
end;
constructor TCustomCtrlTest.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Sub:= TButton.Create(Self);
Sub.Parent:= Self; // Typically, creating a sub-control and setting its Parent property to your main control will work just fine inside of your main control's constructor, provided that the sub-control does not require a valid HWND right way. Remy Lebeau
WriteToString('Create'+ #13#10);
end;
procedure TCustomCtrlTest.Loaded;
begin
inherited;
WriteToString('Loaded'+ #13#10);
end;
procedure TCustomCtrlTest.AfterConstruction;
begin
inherited;
WriteToString('AfterConstruction'+ #13#10);
end;
procedure TCustomCtrlTest.CreateWnd;
begin
WriteToString(' CreateWnd'+ #13#10);
inherited;
WriteToString(' CreateWnd post'+ #13#10);
Sub.Visible:= TRUE;
Sub.Align:= alLeft;
Sub.Caption:= 'SOMETHING';
Sub.Font.Size:= 20;
end;
procedure TCustomCtrlTest.CreateWindowHandle(const Params: TCreateParams);
begin
inherited CreateWindowHandle(Params);
WriteToString(' CreateWindowHandle'+ #13#10);
end;
procedure TCustomCtrlTest.SetParent(AParent: TWinControl);
begin
WriteToString('SetParent'+ #13#10);
inherited SetParent(AParent);
WriteToString('SetParent post'+ #13#10);
if NOT Initialized then { Make sure we don't call this code twice }
begin
Initialized:= TRUE;
SetMoreStuffHere;
end;
end;
procedure TCustomCtrlTest.WriteToString(s: string);
begin
System.IOUtils.TFile.AppendAllText('test.txt', s);
// The output will be in Delphi\bin folder when the control is used inside the IDE (dropped on a form) c:\Delphi\Delphi XE7\bin\
// and in app's folder when running inside the EXE file.
end;
end.
The order is:
Dropping control on a form:
Create
AfterConstruction
SetParent
CreateWnd
CreateWindowHandle
CreateWnd post
SetParent post
Deleting control from form:
SetParent
SetParent post
Cutting ctrol from form and pasting it back:
SetParent
SetParent post
Create
AfterConstruction
SetParent
CreateWnd
CreateWindowHandle
CreateWnd post
SetParent post
SetParent
SetParent post
Loaded
Executing the program
Create
AfterConstruction
SetParent
SetParent post
SetParent
SetParent post
Loaded
CreateWnd
CreateWindowHandle
CreateWnd post
Dynamic creation
Create
AfterConstruction
SetParent
CreateWnd
CreateWindowHandle
CreateWnd post
SetParent post
Reconstructing the form
Not tested yet
The solution I chose in the end is to initialize code that requires a handle in SetParent (or CreateWnd) and use a boolean var to protect from executing that code twice (see SetParent above).

Control over Delphi form components destroy order

Is there any way to control the order of which a Delphi form is destroying its components?
I got AVs when the form is destroying because it is destroying a component before the other component which accesses the first component.
Currently, I have no way to avoid AVs except free the first component in finalization section
You will have to call FreeNotification() on the control being referenced and override the protected Notfication() method of your control that is referencing it.
Say you have a property that links to another component (say, a TEdit):
property EditControl: TEdit read FEdit write SetEdit;
Then, if your property is set to link to such a component, you tell it that you want to be notified when it is freed, by calling its FreeNotification() method:
procedure TMyControl.SetEdit(Value: TEdit);
begin
if FEdit <> Value then
begin
if FEdit <> nil then
FEdit.RemoveFreeNotification(Self);
FEdit := Value;
if FEdit <> nil then
FEdit.FreeNotification(Self);
end;
end;
This means that your Notification() procedure will be called when the TEdit is destroyed. You will have to override it:
protected
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
...
procedure TMyControl.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FEdit) then
FEdit := nil;
end;
That way, you will know when you can access the TEdit component, and when not to anymore. If FEdit is nil, you should not access it.
Examples taken from:
http://mc-computing.com/Languages/Delphi/ComponentNotification.html
Documentation:
http://docwiki.embarcadero.com/Libraries/Seattle/en/System.Classes.TComponent.FreeNotification
I did some search and some tests and found how to control the Delphi form components destroy order.
There are two ways, at design time and at runtime:
At design time, Edit the form's DFM, move the first component's object block as first block before any other object blocks of any other components that must be freed after the first one.
At runtime, in form OnCreate, Change ComponentIndex property of first component to any value lower than the other components which depend on it, Say 0, this will make it last one to be freed.
Example: FirstComp.ComponentIndex := 0;
That's it!
As you can see, Delphi frees components in the opposite order of which they were added to the form (LIFO), But we can alter this order as I explained.
Thanks everyone for your valuable help. Appreciate it.

How to detect that a form is being destroyed across the Application?

We have many forms in our application, and I need a global event handler to detect when one of the forms is being destroyed (and then take some action).
p.s: I want to avoid adding code to each form that will need to send a message to the main form when it's about to destroy. also most of the forms are created and destroyed dynamicaly at run-time.
I was thinking about maybe use a global TApplicationEvents.
What is the best approach for this?
Contrary to David's answer, there is a suitable framework. It's built in higher up in the class hierarchy at TComponent. Sir Rufo is on the right track, but you don't need to force your forms to be owned by this object.
You're welcome to write any number of classes that can take specialised action when a form (or any other component for that matter) is destroyed. E.g.
TDestroyedFormLogger = class(TComponent)
protected
{ Write to log file when forms are destroyed. }
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
end;
TMenuManager = class(TComponent)
protected
{ Remove/hide a menu item corresponding to the form that has been destroyed. }
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
end;
Now whenever you create a form, simply set a notification as follows (assuming you have given yourself access to suitable instances of the above objects):
LForm := TMyForm.Create(Application);
LForm.FreeNotification(DestroyedFormLogger);
LForm.FreeNotification(MenuManager);
This approach is better than using the OnDestroy event because that permits only 1 observer, whereas FreeNotification permits any number of observers.
NOTE: As with any useful technique, don't force-fit a problem to the technique. There may be a more appropriate technique to your specific problem. E.g. The MenuManager idea might be better solved by using the global Screen object to iterate forms OnPopup.
EDIT: Explanation of Observer Pattern
The TComponent notification mechanism is a built-in implementation of the Observer Pattern for when a component is destroyed. FreeNotification (perhaps not ideally named) is the equivalent of registerObserver and RemoveNotification the equivalent of unregisterObserver.
The whole point of the observer pattern is that the subject being observed (sometimes called publisher) has no type-specific knowledge of the objects that are observing it (sometimes called subscribers). Publishers only know that they are able to call a generic notification method on each registered subscriber (observer). This allows objects to be loosely coupled from those that are watching it. In fact the publisher doesn't even need to be observed at all. Obviously the registration method needs to be called either from the subscribers themselves or from a third-party - otherwise the decoupling objective is defeated.
Observers can be implemented at varying degrees of complexity. The simplest being an event or callback. The most complex being a dispatcher that manages registrations in-between and independent of both publishers and subscribers. The dispatcher might even implement thread switching so that publishers don't even get impacted by performance side-effects of slow subscribers.
TComponent's observer implementation has a limitation that both the publisher and subscriber must inherit from TComponent. Basically any component can register with another component to be notified of its destruction.
Perhaps the most common use of this feature in Delphi is: When component A has a reference to component B; If component B is destroyed, component A is notified so that it can set its reference to nil.
What you are wanting is for the framework to fire an event when a form is destroyed. When a form is destroyed, its destructor is run. So, in order for the framework to fire such an event, it would need to be implemented from within the form's destructor. If you take a look inside TCustomForm.Destroy, you will find that there is not such event.
From this we can conclude that there can be no application wide event fired whenever a form is destroyed. This means that you will have to implement a solution yourself. One obvious way to make this happen is to introduce a common base class for all your forms. Ensure that every form in your program derives ultimately from this common base class. Then arrange for the base class to surface an event that is fired whenever an instance is destroyed.
There seems to be some mis-understanding about what I am saying above. Craig demonstrates how to subscribe to notification of a single form's destruction. The ability to do that does not contradict what I am saying. My point is that there is no mechanism in place that allows you to subscribe to receive notification when any form is destroyed.
A constraint on modifying code in existing forms, or creation of forms, as can be seen from other answers and comments, leaves hacks and hooks. A local CBT hook, f.i., would be a little work but probably work fine. Below is one of the simpler hacky solutions.
Screen global object holds a list of forms at all times via a regular TList. TList has a virtual Notify procedure which is called every time an item is added/removed. The idea is to employ a TList derivative that overrides this method and use it in the Screen object.
type
TNotifyList = class(TList)
protected
procedure Notify(Ptr: Pointer; Action: TListNotification); override;
end;
procedure TNotifyList.Notify(Ptr: Pointer; Action: TListNotification);
begin
inherited;
if (Action = lnDeleted) and (csDestroying in TForm(Ptr).ComponentState) and
(TForm(Ptr) <> Application.MainForm) then
// do not use ShowMessage or any 'TForm' based dialog here
MessageBox(0,
PChar(Format('%s [%s]', [TForm(Ptr).ClassName, TForm(Ptr).Name])), '', 0);
end;
Testing for csDestroying is required because the Screen adds/removes forms to its list not only when forms are created/destroyed but also when they are activated etc..
Then make the Screen use this list. This requires an "accessing private fields" hack, as the FForms list is private. You can read about this hack on Hallvard Vassbotn's blog. It also requires "changing the class of an object at run time" hack. You can read about this hack on Hallvard Vassbotn's blog.
type
THackScreenFForms = class
{$IF CompilerVersion = 15}
Filler: array [1..72] of Byte;
{$ELSE}
{$MESSAGE ERROR 'verify/modify field position before compiling'}
{$IFEND}
Forms: TList;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
PPointer(THackScreenFForms(Screen).Forms)^ := TNotifyList;
end;
Note that the notification will be called for every form destruction. This also includes forms created through MessageDlg, ShowMessage etc..
This is not the best practice (have a look at David's answer) but a way to go.
Since every form can have an owner (type TComponent) and this owner gets notified, if a child component is destroyed, just create a global form owner and pass this as the owner of every created form you want to get notified on destroy.
You have to override the TComponent.Notification method and do what you have to (e.g. fire an event)
unit GlobalViewHolder;
interface
uses
Forms,
Classes;
type
TComponentNotificationEvent = procedure( Sender : TObject; AComponent : TComponent; Operation : TOperation ) of object;
TGlobalViewHolder = class( TComponent )
private
FOnNotification : TComponentNotificationEvent;
protected
procedure Notification( AComponent : TComponent; Operation : TOperation ); override;
public
property OnNotification : TComponentNotificationEvent read FOnNotification write FOnNotification;
end;
// small and simple singleton :o)
function ViewHolder : TGlobalViewHolder;
implementation
var
_ViewHolder : TGlobalViewHolder;
function ViewHolder : TGlobalViewHolder;
begin
if not Assigned( _ViewHolder )
then
_ViewHolder := TGlobalViewHolder.Create( Application );
Result := _ViewHolder;
end;
{ TGlobalViewHolder }
procedure TGlobalViewHolder.Notification( AComponent : TComponent; Operation : TOperation );
begin
inherited;
if Assigned( OnNotification )
then
OnNotification( Self, AComponent, Operation );
end;
end.
The main form owner is always Application but there is no need to track this.
Personally I'd prefer David Heffernan's solution since all my forms are allways based on a template and it would be the cleanest and easiest to implement way.
But coming from you demand
p.s: I want to avoid adding code to each form that will need to send a message to the main form when it's about to destroy. also most of the forms are created and destroyed dynamicaly at run-time.
you would be able to patch Destroy to an own method.
I'd take the latest called destructor in the chain and patch TObject.Destroy to TMyClass.Destroy. The place to implement should be the project.
The code for patching is taken from David Heffernan 's answer on Patch routine call in delphi and only included to keep the answer complete, credits regarding this code go there.
program AInformOnCloseForms;
uses
Forms,
Classes,
Windows,
Dialogs,
Unit3 in 'Unit3.pas' {Mainform},
Unit4 in 'Unit4.pas' {Form2};
{$R *.res}
// PatchCode and RedirectProcedure are taken from David Heffernans answer
// https://stackoverflow.com/a/8978266/1699210
// on "Patch routine call in delphi" , credits regarding this code go there
procedure PatchCode(Address: Pointer; const NewCode; Size: Integer);
var
OldProtect: DWORD;
begin
if VirtualProtect(Address, Size, PAGE_EXECUTE_READWRITE, OldProtect) then
begin
Move(NewCode, Address^, Size);
FlushInstructionCache(GetCurrentProcess, Address, Size);
VirtualProtect(Address, Size, OldProtect, #OldProtect);
end;
end;
type
PInstruction = ^TInstruction;
TInstruction = packed record
Opcode: Byte;
Offset: Integer;
end;
procedure RedirectProcedure(OldAddress, NewAddress: Pointer);
var
NewCode: TInstruction;
begin
NewCode.Opcode := $E9;//jump relative
NewCode.Offset := NativeInt(NewAddress)-NativeInt(OldAddress)-SizeOf(NewCode);
PatchCode(OldAddress, NewCode, SizeOf(NewCode));
end;
type
TMyClass=Class(TObject) // Dummy to handle "events"
public
Destructor Destroy;override;
End;
destructor TMyClass.Destroy;
begin
// pervent recursion from call to Showmessage
if (Self.InheritsFrom(TCustomForm)) and (Self.ClassName<>'TTaskMessageDialog') then
Showmessage(Self.ClassName);
end;
begin
RedirectProcedure(#TObject.Destroy,#TMyClass.Destroy);
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TMainform, Mainform);
Application.CreateForm(TForm2, Form2);
Application.Run;
end.
As per Vlad's request this expands on my original answer by explaining how to register all forms owned by Application without any changes to the construction of each form. I.e. forms created using TMyForm.Create(Application); and by implication also Application.CreateForm(TMyForm, MyForm);.
The original answer doesn't specify any particular means of registering for FreeNotification because the options vary according to how forms are created. Since the question answered did not put any constraints on how the forms are created, the original answer is more appropriate in the general case.
If we could ensure that Application referred to a custom subclass of TApplication, the problem would be fairly easy to solve by overriding TApplication.Notification;. That's not possible, so this special case leverages the fact that the component ownership framework notifies all owned components when another component is added or removed. So basically all we need is a component tracker also owned by Application and we can react on its "sibling" notifications.
The following test case will demonstrate that new notifications work.
procedure TComponentTrackerTests.TestNewNotifications;
var
LComponentTracker: TComponentTracker;
LInitialFormCount: Integer;
LForm: TObject;
begin
LComponentTracker := TComponentTracker.Create(Application);
try
LComponentTracker.OnComponentNotification := CountOwnedForms;
LInitialFormCount := FOwnedFormCount;
LForm := TForm.Create(Application);
CheckEquals(LInitialFormCount + 1, FOwnedFormCount, 'Form added');
LForm.Free;
CheckEquals(LInitialFormCount, FOwnedFormCount, 'Form removed');
finally
LComponentTracker.Free;
end;
end;
procedure TComponentTrackerTests.CountOwnedForms(AComponent: TComponent; AOperation: TOperation);
begin
if (AComponent is TCustomForm) then
begin
case AOperation of
opInsert: Inc(FOwnedFormCount);
opRemove: Dec(FOwnedFormCount);
end;
end;
end;
TComponentTracker is implemented as follows:
TComponentNotificationEvent = procedure (AComponent: TComponent; AOperation: TOperation) of object;
TComponentTracker = class(TComponent)
private
FOnComponentNotification: TComponentNotificationEvent;
procedure SetOnComponentNotification(const Value: TComponentNotificationEvent);
procedure DoComponentNotification(AComponent: TComponent; AOperation: TOperation);
protected
procedure Notification(AComponent: TComponent; AOperation: TOperation); override;
public
property OnComponentNotification: TComponentNotificationEvent read FOnComponentNotification write SetOnComponentNotification;
end;
procedure TComponentTracker.DoComponentNotification(AComponent: TComponent; AOperation: TOperation);
begin
if Assigned(FOnComponentNotification) then
begin
FOnComponentNotification(AComponent, AOperation);
end;
end;
procedure TComponentTracker.Notification(AComponent: TComponent; AOperation: TOperation);
begin
inherited Notification(AComponent, AOperation);
DoComponentNotification(AComponent, AOperation);
end;
procedure TComponentTracker.SetOnComponentNotification(const Value: TComponentNotificationEvent);
var
LComponent: TComponent;
begin
FOnComponentNotification := Value;
if Assigned(Value) then
begin
{ Report all currently owned components }
for LComponent in Owner do
begin
DoComponentNotification(LComponent, opInsert);
end;
end;
end;
WARNING
You could implement anything you choose in the OnComponentNotification event handler. This would include logging that the form is "destroyed". However, such a simplistic approach would actually be flawed because TComponent.InsertComponent allows a component's owner to be changed without destroying it.
Therefore to accurately report destruction, you would have to combine this with using FreeNotification as in my first answer.
This is quite easily done by setting LComponentTracker.OnComponentNotification := FDestructionLogger.RegisterFreeNotification; where RegisterFreeNotification is implemented as follows:
procedure TDestructionLogger.RegisterFreeNotification(AComponent: TComponent; AOperation: TOperation);
begin
if (AComponent is TCustomForm) then
begin
case AOperation of
opInsert: AComponent.FreeNotification(Self);
end;
end;
end;
A very simple approach could be keeping track of the Form count. When it lowers, then there is a Form destroyed. Check in Application.OnIdle:
procedure TMainForm.ApplicationEvents1Idle(Sender: TObject; var Done: Boolean);
begin
if Screen.CustomFormCount < FFormCount then
FormDestroyed;
if FFormCount <> Screen.CustomFormCount then
FFormCount := Screen.CustomFormCount;
end;
Depending on what action should be taken, you can loop through Screen.CustomForms to determine which Form was destroyed.

Stop event propagation in Delphi 7

I'm stuck on a problem in Delphi 7 about event propagation (due to my ignorance).
I am asked to dynamically attach an OnMouseUp event handler on some controls on a form (and I'm fine with that thing), but if the OnMouseUp is present, the OnClick event on that control must not be processed.
Background
If you are asking the reason behind this, well, I'm in charge to modify an old production monitoring application (sigh) that from now on must accommodate a conditional behaviour for some controls, in direct response to a former click on a special function button.
Some of those controls have an OnClick event handler already; the first solution the team came up with was to punctually intervene on each OnClick handler and manage out the contextual actions in relation to the special function button status.
I suggested to take advantage of the Object-Oriented design already in place for the application forms: they all inherit from the same custom ancestor object, so I planned to insert an initialization method there to dynamically attach OnMouseUp events to the controls that are declared to support it in subclasses.
The need
I'm not hereby asking a validation or questioning on the (possible lack of) design goodness about all this (by the way, after a lot of thinking and reasoning it seemed to be the path we can walk with less pain); my problem is that for such design to take place I'd have to let dynamically-attached OnMouseUp event handlers stop event propagation to the pre-existent OnClick events on those controls.
Is it possible with Delphi 7?
Please note, the following does not explicitly answer the question here. It's more a proposal to the concept re-design (redirect OnClick events instead of adding extra OnMouseUp). It's about how to redirect OnClick event handler (if assigned some) of all components (might be filtered, if needed) to another (common) OnClick event handler. It includes also a method for restoring them to the original state.
In the following example I'll try to show you how to replace and then optionally restore the OnClick event handlers (if the component has written some) by the specific one. This is done to all components having the OnClick event published, so you don't need to know in advance if the component class has OnClick event available or not (but it can very simply be modified to use only a specific class).
The code consists from the following:
OnSpecialClick - it is the event handler to what all OnClick events will be binded when you call the ReplaceOnClickEvents procedure, notice that it must be published to be visible for RTTI !!!
Button1Click - represents here the old event handler which should be replaced, it is binded to the Button1.OnClick event at design time
ReplaceOnClickEvents - method, which iterates through all components on the form and checks if the currently iterated one has the OnClick event handler assigned; if so, it stores it into a backup collection and replace this event handler by the OnSpecialClick
RestoreOnClickEvents - method, which restores the original OnClick event handlers; it iterates through the backup collection and assign the event methods to its stored component instances
CheckBox1Click - this check box click event is meant to be the switch between the common and a special mode (CheckBox1 checked state means to be the special mode), only this OnClick event is not replaced by the ReplaceOnClickEvents call (because you wouldn't be able to restore the mode back to normal)
And here it is:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, TypInfo, StdCtrls, Contnrs;
type
TEventBackup = class
Component: TComponent;
OnClickMethod: TMethod;
end;
type
TForm1 = class(TForm)
Button1: TButton;
CheckBox1: TCheckBox;
procedure Button1Click(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
private
procedure ReplaceOnClickEvents;
procedure RestoreOnClickEvents;
published
procedure OnSpecialClick(Sender: TObject);
end;
var
Form1: TForm1;
EventBackupList: TObjectList;
implementation
{$R *.dfm}
procedure TForm1.OnSpecialClick(Sender: TObject);
begin
ShowMessage('Hi, I''m an OnSpecialClick event message!');
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage('Hi, I''m just that boring original OnClick event message!');
end;
procedure TForm1.ReplaceOnClickEvents;
var
I: Integer;
Component: TComponent;
EventMethod: TMethod;
EventBackup: TEventBackup;
begin
for I := 0 to ComponentCount - 1 do
begin
Component := Components[I];
if Component = CheckBox1 then
Continue;
if IsPublishedProp(Component, 'OnClick') then
begin
EventMethod := GetMethodProp(Component, 'OnClick');
if Assigned(EventMethod.Code) and Assigned(EventMethod.Data) then
begin
EventBackup := TEventBackup.Create;
EventBackup.Component := Component;
EventBackup.OnClickMethod := EventMethod;
EventBackupList.Add(EventBackup);
EventMethod.Code := MethodAddress('OnSpecialClick');
EventMethod.Data := Pointer(Self);
SetMethodProp(Component, 'OnClick', EventMethod);
end;
end;
end;
end;
procedure TForm1.RestoreOnClickEvents;
var
I: Integer;
EventBackup: TEventBackup;
begin
for I := 0 to EventBackupList.Count - 1 do
begin
EventBackup := TEventBackup(EventBackupList[I]);
SetMethodProp(EventBackup.Component, 'OnClick', EventBackup.OnClickMethod);
end;
EventBackupList.Clear;
end;
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
if CheckBox1.Checked then
ReplaceOnClickEvents
else
RestoreOnClickEvents;
end;
initialization
EventBackupList := TObjectList.Create;
EventBackupList.OwnsObjects := True;
finalization
EventBackupList.Free;
end.
As both TLama and TOndrej have said, there are a few ways to accomplish what you're attempting:
To do if Assigned(Control.OnMouseUp) then Exit; on your OnClick event handler
To "unassign" the OnClick event when assigning OnMouseUp (and vice-versa)
Both approaches will accomplish what you've detailed, though "unassigning" the OnClick event will be best for performance (to an infintismally small extent) since you won't be performing the if statement repeatedly.

How to implement some sort of Form Manager?

I'm in the middle of a project with a number of child forms. Many of the forms may be open at once. I'd like to know if there's already something I can use to manage and keep track of these forms, much like the windows taskbar and/or task manager. If not, then what would be the best approach? I don't want to have to reinvent the wheel if this is already done.
Description
As mentioned above, this project has many forms which may be opened at once. I will also be implementing some visual list control (much like the taskbar or task manager) for user control of these forms (or in the user's case, the forms are called windows). The most ideal way to manage these would be to first capture each of these forms as they're created and keep record of them somewhere. Some forms need this behavior, and some forms do not. For example, modal forms will never need this handling.
I will be giving the user access to show, minimize, or close these forms, as well as some other future un-thought handling, like maybe a custom popup menu associated with one of these forms (but that's another subject). The point is, I need to build something to capture these forms and keep them in order.
This will also include some other user interaction with all the forms at once, as well as simple access to each one of them, similar to how Screen.Forms already works. For example, a command to minimize all forms (FormManager.MinimizeAll), to maximize the currently active form (FormManager.ActiveForm.Maximize), or with a particular form (FormManager[3].Maximize).
Possible Options
I understand there are a few far different approaches to accomplish similar results, and haven't started coding it yet because each of those approaches has a different starting point. The options are...
Wrap Screen.Forms and other associated functionality from the Screen (which wouldn't allow too much of my desired flexibility)
Every time I create a form, register it with this form manager (which is very flexible, but I have to make sure I always register each created form)
Build a master form to register its self with the form manager and inherit everything from it (which is also very flexible, but in different ways, and much more complex)
The second option is sounding the most promising so far. But again, I don't want to start building it if there is already a solution for this. I'm pretty confident that I'm not the first person to do this. I don't know how to search for such a thing, I get nothing related to what I want on Google.
The global variable Screen (in Forms unit) does some "tracking", ie
Screen.Forms list all currently open forms;
Screen.ActiveForm form which has input focus (see also FocusedForm);
Screen.OnActiveFormChange event;
You could add each form to a TObjectList. I wrote a component called FormStack, which allows you to add forms (even forms with the same name), retrieve, remove, etc. To get a Task Manager like behavior, I think you'd just need to iterate the list to obtain form names . Hopefully you can use something here to shed some light on your idea..
Here's the code for FormStack.
unit uFormstack;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Contnrs;
type
TFormstack = class(TComponent)
private
{ Private declarations }
FormList: TObjectList;
protected
{ Protected declarations }
public
{ Public declarations }
Constructor Create(AOwner: TComponent); Override;
Destructor Destroy; Override;
Procedure Add(InstanceClass: TComponentClass; Var Reference);
Procedure RemoveLast;
Procedure RemoveAll;
Function FindForm(AComponentClass: TComponentClass): Boolean;
Function GetForm(AComponentClass: TComponentClass): TObject;
Function GetByIndex(AIndex: Integer): TObject;
Procedure RemoveByIndex(AIndex: Integer);
published
{ Published declarations }
end;
procedure Register;
implementation
//{$R *.res}
procedure Register;
begin
RegisterComponents('FormStack', [TFormstack]);
end;
{-----------------------------------------------------------------------------
TFormStack
-----------------------------------------------------------------------------}
Constructor TFormStack.Create(AOwner: TComponent);
Begin
Inherited Create(AOwner);
FormList := TObjectList.Create;
FormList.OwnsObjects := True;
End;
Destructor TFormStack.Destroy;
Begin
FormList.Free;
Inherited Destroy;
End;
Procedure TFormStack.Add(InstanceClass: TComponentClass; Var Reference);
Var
Instance: TComponent;
Begin
Instance := TComponent(InstanceClass.NewInstance);
TComponent(Reference) := Instance;
Instance.Create(Self); // Owner is FormList <<-- blows up if datamodule in D2010
FormList.Add(Instance);
Instance.Tag := FormList.Count-1;
End;
Procedure TFormStack.RemoveAll;
Var
I: Integer;
Begin
For I := FormList.Count -1 downto 0 do // last in first out
begin
Self.RemoveLast;
End;
End;
// This removes the last form on the stack
Procedure TFormStack.RemoveLast;
Begin
if FormList.Count > 0 then
FormList.Remove(FormList.Items[FormList.Count-1]);
End;
Function TFormStack.FindForm(AComponentClass: TComponentClass): Boolean;
Var
I: Integer;
Begin
Result := False;
For I := FormList.Count-1 downto 0 do
If Formlist.Items[I].ClassType = AComponentClass then
Result := True;
End;
Function TFormStack.GetForm(AComponentClass: TComponentClass): TObject;
Var
I: Integer;
begin
Result := Nil;
For I := FormList.Count-1 downto 0 do
If Formlist.Items[I].ClassType = AComponentClass then
Result := FormList.Items[I];
end;
Function TFormStack.GetByIndex(AIndex: Integer): TObject;
begin
Result := Nil;
If FormList.Count-1 >= AIndex then
Result := FormList.Items[AIndex];
end;
Procedure TFormStack.RemoveByIndex(AIndex: Integer);
begin
If FormList.Count-1 >= AIndex then
FormList.Remove(FormList.Items[AIndex]);
end;
end.
If I understand you correctly, you want to track this in code while the app is running?
Maybe you can do something with Screen.Forms?

Resources