How can I create a fake integer property? - delphi

I'm trying to create a fake or pseudo property for child controls, and have tried to follow this article: https://edn.embarcadero.com/article/33448
However, that was written some years ago, so I don't know how much Delphi might have changed since then in a way that could matter here.
Unlike the goal of that article, I'm trying to have a number property that is essentially the index of the control in its parent. This is for when a particular custom control (OrderLayoutObj) is the parent (although it might have applicability in other cases where I want to change the order of a control in its parent's Children list without having to manually reorder the controls in the .fmx.)
In place of the article's TAddPropertyFilter, this is my declaration and implementation. It matches the article's one pretty closely, and I don't think there is a problem with it. (Sorry for my umm, unconventional, naming and formatting.)
AddOrderProperty = class(TSelectionEditor, ISelectionPropertyFilter)
procedure FilterProperties(const ASelection: IDesignerSelections; const ASelectionProperties:IInterfaceList);
end;
procedure AddOrderProperty.FilterProperties(const ASelection:IDesignerSelections; const ASelectionProperties:IInterfaceList);
var OrderProperty: ControlOrderPropertyObj;
begin
if ASelection.Count<>1 then Exit;
if ASelection[0] is TControl then begin
if not (TControl(ASelection[0]).Parent is OrderLayoutObj) then Exit;
OrderProperty:=ControlOrderPropertyObj.Create(inherited Designer,1);
OrderProperty.Control:=TControl(ASelection[0]);
ASelectionProperties.Add(OrderProperty as IProperty);
end;
end;
I also don't think that there's a problem with my Register procedure:
procedure Register;
begin
DesignIntf.RegisterSelectionEditor(TControl,AddOrderProperty);
end;
I think the real problem is in my equivalent of the article's TBaseComponentPropertyEditor and its descendant TControlParentProperty which were designed to allow a control to be selected. Instead of using that I've based it on TIntegerProperty, given that my additional property is an integer, and not knowing if the article's author used what he did because he didn't have a better descendant available at the time of the article.
(I did try try basing it on TBasePropertyEditor, but that didn't work either, although the property did appear in the Object Inspector, and then produced an error. I don't recall the exact details, though.)
ControlOrderPropertyObj = class(TIntegerProperty)
private
OrderControl: OrderLayoutObj;
ControlF: TControl;
procedure Control_Set(C:TControl);
protected
function GetEditValue(out Value:string):Boolean;
public
function GetName:string; override;
function GetValue:string; override;
procedure SetValue(const Value:string); override;
property Control:TControl read ControlF write Control_Set;
end; {AddControlFilter}
procedure ControlOrderPropertyObj.Control_Set(C:TControl);
begin
ControlF:=C;
OrderControl:=C.Parent as OrderLayoutObj;
end;
function ControlOrderPropertyObj.GetEditValue(out Value:string):Boolean; //This is a copy of the method from the article.
begin
Value:=GetValue;
Result:=True;
end;
function ControlOrderPropertyObj.GetName:string;
begin
Result:='ControlIndex';
end;
function ControlOrderPropertyObj.GetValue:string;
begin
GetValue:=OrderControl.PositionOf(Control).ToString;
end;
procedure ControlOrderPropertyObj.SetValue(const Value:string);
begin
OrderControl.ChangePosition(Control,Value.ToInteger);
end;
I think the problem is with another IProperty or other method that I haven't overridden, but the only clue as to which one is that it's producing an access violation (when clicking on the child component in the form editor) in line 752 of DesignEditors.pas. That's on the Result:= line of this method:
function TPropertyEditor.GetPropType: PTypeInfo;
begin
Result := FPropList^[0].PropInfo^.PropType^;
end;
Although I've done it years ago, I've been unable to debug the design-time .bpl by setting Run>Parameters>Host name to Delphi itself.

Related

Avoid that SetFocus raises an Exception

I am working at a huge, legacy source code where several SetFocus is called at many places, but sometimes, the check if the control is visible or enabled is missing.
Due to limited time, and the huge amount of source code, I decided that I want to ignore these errors, since the focus is (in our case) not a critical feature. A raised Exception will result in a complete failure, while a missing focus is just an optical issue.
My current plan is following:
I create an unit with a class helper like this:
type
TWinControlEx = class helper for TWinControl
procedure SetFocusSafe;
end;
procedure TWinControlEx.SetFocusSafe;
begin
if CanFocus then SetFocus;
end;
I include the unit to every unit which uses ".SetFocus" (I will use the global code search)
I replace every .SetFocus with .SetFocusSafe
There is a problem though: If possible, I want to avoid that coworkers accidently use .SetFocus , or forget to include the classhelper unit.
Which other options do I have?
The best case would be if there is a technique/hack to make SetFocus not raising an exception. (Without recompiling the VCL)
Just patch the TWinControl.SetFocus method:
unit SetFocusFix;
interface
implementation
uses
Controls,
Forms,
SysUtils,
Windows;
type
TWinControlHack = class(TWinControl)
public
procedure SetFocus; override;
end;
procedure TWinControlHack.SetFocus;
var
Parent: TCustomForm;
begin
if not CanFocus then Exit;
Parent := GetParentForm(Self);
if Parent <> nil then
Parent.FocusControl(Self)
else if ParentWindow <> 0 then
Windows.SetFocus(Handle)
else
ValidParentForm(Self);
end;
procedure RedirectFunction(OrgProc, NewProc: Pointer);
type
TJmpBuffer = packed record
Jmp: Byte;
Offset: Integer;
end;
var
n: UINT_PTR;
JmpBuffer: TJmpBuffer;
begin
JmpBuffer.Jmp := $E9;
JmpBuffer.Offset := PByte(NewProc) - (PByte(OrgProc) + 5);
if not WriteProcessMemory(GetCurrentProcess, OrgProc, #JmpBuffer, SizeOf(JmpBuffer), n) then
RaiseLastOSError;
end;
initialization
RedirectFunction(#TWinControl.SetFocus, #TWinControlHack.SetFocus);
end.
Alternatively
TWinControlEx = class helper for TWinControl
procedure SetFocus; reintroduce;
end;
with...
procedure TWinControlEx.SetFocus;
var
Parent: TCustomForm;
begin
if not CanFocus then Exit;
Parent := GetParentForm(Self);
if Parent <> nil then
Parent.FocusControl(Self)
else if ParentWindow <> 0 then
Winapi.Windows.SetFocus(Handle)
else
ValidParentForm(Self);
end;
My answer below does not answer DIRECTLY your question but it is still relevant because you rely on CanFocus. CanFocus returns a lie. You should not rely on it. The documentation is also wrong. More exactly, CanFocus can return True even if the control is not focusable. In this case an exception will be raised.
So, use this instead:
function CanFocus(Control: TWinControl): Boolean;
begin
Result:= Control.CanFocus AND Control.Enabled AND Control.Visible;
if Result
AND NOT Control.InheritsFrom(TForm)
then
{ Recursive call:
This control might be hosted by a panel which could be also invisible/disabled.
So, we need to check all the parents down the road, until we encounter the parent Form.
Also see: GetParentForm }
Result:= CanFocus(Control.Parent); { Parent of a control could be nil, but in this case Control.CanFocus will deal with that.}
end;
procedure SetFocus(Control: TWinControl);
begin
if CanFocus(Control)
then Control.SetFocus;
end;
PS: Under Lazarus CanFocus works properly.
Justification:
J provided a nice answer, but I don't like class helpers because if you have more than one class helper for the same class, the only one will be used. The process is almost "by dice": the order of the units in the "uses" clause determine which helper will apply. I don't like this amount of randomness in a programming language.

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.

How do we activate (on demand) an object that is a property of another object?

I am implementing an object TTextFile that is a framework for using the low level pascal file function with the OO paradigm. I want to add to developers the option to use it as a TStringList when needed in the same object, like this:
TTextFile = class(TObject)
constructor Create(FileName: String);
procedure OpenForRead;
procedure OpenForWrite;
{...}
property Content: TStringList;
end;
But my problem is that I want the Content property to use user LoadFromFile only at the first time the application uses it. Not in the Create construction, because the file might be too big, and the programmer would prefer to use the other functions in this case. The Content would be use when he knows the file he is using will not be very big.
An example of a big file is a list with all the client names and citizen ID. An example of a very tiny file is that same list, but only with the clients that are waiting to be attended in the current day.
Is it possible to be done in OO pascal? If it is not possible, I will have to make a kind of activation procedure or an overload Create and make the programmer always check if the Content is loaded before use it.
Use the concept of lazy initialization. The first time the Content property is read, load the file contents, but then keep the contents available so that subsequent accesses of the property don't re-read the file.
private
FContent: TStrings;
function GetContent: TStrings;
public
property Content: TStrings read GetContent;
function TTextFile.GetContent: TStrings;
begin
if not Assigned(FContent) then begin
FContent := TStringList.Create;
try
FContent.LoadFromFile(FFileName);
except
FContent.Free;
FContent := nil;
raise;
end;
end;
Result := FContent;
end;
Certainly this is possible.
Change your class declaration:
TTextFile = class(TObject)
constructor Create(FileName: String);
procedure OpenForRead;
procedure OpenForWrite;
function GetContent: TStringList;
{...}
property Content: TStringList read GetContent;
end;
and implement it:
function TTextFile.GetContent: TStringList;
begin
Result := TStringList.Create;
Result.LoadFromFile(FFileName); // Presumes FileName is stored in FFileName in constructor
end;

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?

Delphi: How to set text in TEdit/TMaskEdit without invoking the onchange event

I've got a pretty big setup form which I'd like to populate with data from a class. so I'm doing a lot of
Edt1.text := ASettings.FirstThing;
I'd like to avoid
Edt1.onchange := nil;
Edt1.text := ASettings.FirstThing;
Edt1.onchange := edt1Onchange;
How do I change the text in a text box and sidestep the onchange event.
I have used something like changing the OnChange handler, but more often, I use a flag.
updatingFromCode := true;
Edt1.Text := ASettings.FirstThing;
updatingFromCode := false;
then
procedure TForm1.OnChange(...);
begin
if updatingFromCode then
Exit;
...
Also, rather than hardcoding the OnChange the the actual OnChange procedure, I would store the Edit control's current value, then reset it (which will work if it is not set, or if another place has changed it, etc.)
oldOnChange := Edt1.OnChange;
Edt1.OnChange := nil;
Edt1.Text := ASettings.FirstThing;
Edt1.OnChange := oldOnChange;
You might consider using an object to manage the NIL'ing of the event and restoring the previously installed event handler. It's a little dangerous to assume that the event to be restored just happens to be the one assigned at design-time/which happens to have the "name that fits" - you should always save/restore the currently assigned handler, just to be safe.
This would provide an even more re-usable utility than the SetTextWithoutOnChange() routine:
TSuspendEvent = class
private
fObject: TObject;
fEvent: String;
fHandler: TMethod;
public
constructor Create(const aObject: TObject; aEvent: String);
destructor Destroy; override;
end;
constructor TSuspendEvent.Create(const aObject: TObject; aEvent: String);
const
NILEvent : TMethod = (Code: NIL; Data: NIL);
begin
inherited Create;
fObject := aObject;
fEvent := aEvent;
fHandler := GetMethodProp(aObject, aEvent);
SetMethodProp(aObject, aEvent, NILEvent);
end;
destructor TSuspendEvent.Destroy;
begin
SetMethodProp(fObject, fEvent, fHandler);
inherited;
end;
In usage, this would look something like:
with TSuspendEvent.Create(Edit1, 'OnChange') do
try
Edit1.Text := 'Reset!';
finally
Free;
end;
For the "Thou shalt not use 'with' crowd" - by all means declare yourself an additional local variable and use that if it will help you sleep easier at night. :)
Or, to make it even more convenient to use and eliminate "with", I would make the TSuspendEvent class an interfaced object and wrap its use in a function that yielded an interface reference to it that could be allowed to "live in scope", as exemplified by my AutoFree() implementation. In fact, you could use AutoFree() as-is to manage this already:
AutoFree(TSuspendEvent.Create(Edit1, 'OnChange'));
Edit1.Text := 'Reset!';
Dsabling events for a period that extends beyond the scope of a single procedure requires more management than any helper utilities are likely to be able to provide in a generic fashion I think, at least not without also having specific means for restoring events explicitly, rather than automatically.
If you simply wrapped TSuspendEvent inside it's own interface yielding function, following the same pattern as AutoFree() you could simplify this further to:
SuspendEvent(Edit1, 'OnChange');
Edit1.Text := 'Reset!';
As a final note, I think it should be fairly easy to see how this could be quite simply extended to support suspending multiple events on an object in a single call, if required, for example:
SuspendEvent(Edit1, ['OnChange', 'OnEnter']);
As far as I know if the OnChange of your object is designed to fire when the Text property is changed you have to stick with setting the event to nil temporarly. Myself, I do it this way (in a try finally):
Edt1.onchange := nil;
try
Edt1.text := ASettings.FirstThing;
finally
Edt1.onchange := edt1Onchange;
end;
You could also do some procedure to handle it for you:
procedure SetTextWithoutOnChange(anEdit: TEdit; str: String);
var
anEvent: TNotifyEvent;
begin
anEvent := anEdit.OnChange;
anEdit.OnChange := nil;
try
anEdit.Text := str;
finally
anEdit.OnChange := anEvent;
end;
end;
I know this is an old question but I thought I would add my solution that does not involve any of the complicated procedures outlined in the previous answers in case it comes up in another search.
The problem is the onChange event itself. I don't use it at all for text fields.
remove all OnChange and use the OnExit instead and tie it to the OnKeyUp.
All Edits have a common ancestor TCustomEdit.
I generally use one method called CustomEditKeyUp and point all the edits on a form to this single method (TEdit, TLabeledEdit etc etc.)
type THack = class(TCustomEdit);
procedure TForm1.CustomeEditKeyUP(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (Key=VK_RETURN) and (Sender is TCustomEdit) then
{This is just to isolate the one occasion when they press the
enter but don't exit immediately}
if Assigned(THack(Sender).OnExit) then THack(Sender).OnExit(Sender);
end;
For some reason, the OnExit is private in a TCustomEdit so the Hack is needed. If you know that the edits are from a different route where the OnExit is public, cast if differently and the Hack is not necessary.
Then For each Edit control, use a specific OnExit
procedure TForm1.MyEditExit(Sender: TObject);
begin
if MyEdit.Modified then
begin
{Do Something here}
MyEdit.Modified := false;
end;
end;
If you want to change the value programmatically without it firing 'OnExit'
....
MyEdit.Text :='I've changed it'
MyEdit.Modified := false;
....
The big advantage for me is that when I am parsing the input for say a valid number, I only have to do this once when editing is completed and not for every single backspace, delete insert etc all surrounded by try except as the various formating functions error out as they don't understand spaces etc.. For database etc, the number of calls will be greatly reduced.
That's my two penneth.
Another way is by using Class Helpers introduced in Delphi 8.
http://docwiki.embarcadero.com/RADStudio/Tokyo/en/Class_and_Record_Helpers_(Delphi)
You could write:
type
TEditHelper = class helper for TEdit
public
procedure SetTextDisableOnChange(const AText: string);
end;
{ TEditHelper }
procedure TEditHelper.SetTextDisableOnChange(const AText: string);
var
OnChangeTmp: TNotifyEvent;
begin
OnChangeTmp:=OnChange;
try
OnChange:=nil;
Text:=AText;
finally
OnChange:=OnChangeTmp;
end;
end;
and then:
EditCtrl.SetTextDisableOnChange('I do not invoke OnChange!');
EditCtrl.Text:='I invoke OnChange';

Resources