Passing object in reference / one place to style objects - delphi

I got quite a large application which is currently being styled up.
To save me changing all the buttons in the IDE/Object Inspector I am planning on just doing a few functions for the main objects like
procedure StyleButton(AButton : TButton)
begin
AButton.Color := clGreen;
AButton.Font.Style = [fsBold];
end;
etc etc and then add that to the forms onCreates as needed
StyleButton(Button1); whatever etc
There is no issue passing objects in params like this. It does just reference the first object right?
It works fine and I can't think of any issues, but because this is a large application which thousands of users I just want to be sure there will be no issues/memory leaks/resource consumpution issues.
Will also be doing similar things with TAdvStringGrid and TEdit/TMemo components.
Then allows just 1 place to change these settings.
Or someone have a better idea?

This is an excellent idea. The function will modify whichever object you pass to it.
You are not passing by reference. You are passing by value. The value you are passing is a reference. "Passing by reference" means you'd use the var or out keywords, which are not appropriate in this situation.

Your idea is just fine, as the other answerers have already said. Just want to propose a solution that goes even further than David's and something you may want to consider in order to avoid having to add many statements like:
StyleButton(Button1);
StyleButton(Button2);
to each and every form for each and every control you would like to style;
What I would propose is to add a single method call to for example each form's OnShow event:
procedure TForm1.FormShow(Sender: TObject);
begin
TStyler.StyleForm(Self);
end;
The TStyler could be implemented in a separate unit that looks like this:
interface
type
TStyler = class;
TStylerClass = class of TStyler;
TStyler = class(TObject)
public
class procedure StyleForm(const aForm: TCustomForm);
class procedure StyleControl(const aControl: TControl); virtual;
class function GetStyler(const aControl: TControl): TStylerClass;
end;
implementation
uses
Contnrs;
type
TButtonStyler = class(TStyler)
public
class procedure StyleControl(const aControl: TControl); override;
end;
TEditStyler = class(TStyler)
public
class procedure StyleControl(const aControl: TControl); override;
end;
TLabelStyler = class(TStyler)
public
class procedure StyleControl(const aControl: TControl); override;
end;
var
_Controls: TClassList;
_Stylers: TClassList;
{ TStyler }
class function TStyler.GetStyler(const aControl: TControl): TStylerClass;
var
idx: Integer;
begin
Result := TStyler;
idx := _Controls.IndexOf(aControl.ClassType);
if idx > -1 then
Result := TStylerClass(_Stylers[idx]);
end;
class procedure TStyler.StyleForm(const aForm: TCustomForm);
procedure _StyleControl(const aControl: TControl);
var
i: Integer;
StylerClass: TStylerClass;
begin
StylerClass := TStyler.GetStyler(aControl);
StylerClass.StyleControl(aControl);
if (aControl is TWinControl) then
for i := 0 to TWinControl(aControl).ControlCount - 1 do
_StyleControl(TWinControl(aControl).Controls[i]);
end;
var
i: Integer;
begin
_StyleControl(aForm);
end;
class procedure TStyler.StyleControl(const aControl: TControl);
begin
// Do nothing. This is a catch all for all controls that do not need specific styling.
end;
{ TButtonStyler }
class procedure TButtonStyler.StyleControl(const aControl: TControl);
begin
inherited;
if aControl is TButton then
begin
TButton(aControl).Font.Color := clRed;
TButton(aControl).Font.Style := [fsBold];
end;
end;
{ TEditStyler }
class procedure TEditStyler.StyleControl(const aControl: TControl);
begin
inherited;
if aControl is TEdit then
begin
TEdit(aControl).Color := clGreen;
end;
end;
{ TLabelStyler }
class procedure TLabelStyler.StyleControl(const aControl: TControl);
begin
inherited;
if aControl is TLabel then
begin
TLabel(aControl).Font.Color := clPurple;
TLabel(aControl).Font.Style := [fsItalic];
end;
end;
initialization
_Controls := TClassList.Create;
_Stylers := TClassList.Create;
_Controls.Add(TButton);
_Stylers.Add(TButtonStyler);
_Controls.Add(TEdit);
_Stylers.Add(TEditStyler);
_Controls.Add(TLabel);
_Stylers.Add(TLabelStyler);
finalization
FreeAndNiL(_Controls);
FreeAndNiL(_Stylers);
end.
This solution basically employs polymorphism and a registry that links control classes to styler classes. It also uses class procedures and functions to avoid having to instantiate anything.
Please note that the registry is implemented in this example as two lists that need to be kept in sync manually as the code assumes that finding a class at index X will find the styler at the same index in the other list. This can of course be improved upon very much, but is sufficient here to show the concept.

No, There is no issue (in your specific case) passing a object as parameter
procedure StyleButton(AButton : TButton)
when you do this you are passing a address memory (reference) and setting some properties of the referenced object, so there is not problem.

To add to what Rob and RRUZ have already said, you could consider an extra helper using open array parameters:
procedure StyleButtons(const Buttons: array of TButton);
var
i: Integer;
begin
for i := low(Buttons) to high(Buttons) do
StyleButton(Buttons[i]);
end;
You can then call this as:
StyleButtons([btnOK, btnCancel, btnRelease64bitDelphi]);
which is, in my view, more readable at the call-site than:
StyleButton(btnOK);
StyleButton(btnCancel);
StyleButton(btnRelease64bitDelphi);
Note that I passed the open array as a const parameter because that is more efficient when dealing with arrays. Because each element of the array is itself a reference to the button, you are able to modify the actual button. The const just means that you cannot change the reference.

Related

Delphi DefineProperties unpublished property DFM order

I'm developing a component for Query. It works like the "Properties" feature of DevExpress, but I need to place the order of the Unpublished Property I wrote to DFM with DefineProperties in the DFM file at the top of the TCollectionItem.
It works the same way in DevExpress. If you add a Field to the cxGrid and assign a value to the Properties property, you will see the value "PropertiesClassName" in the DFM file at the top.
When I open the DFM file and bring this Property to the top, the setter property of the "PropertiesClassName" Property works and I create that Class. It works seamlessly when reading data from the DFM stream. But no matter what I did I couldn't get the "PropertiesClassName" Property value to the top.
If you create a cxGrid on the form and add Field, and then take the "PropertiesClassName" property from DFM to the bottom of the DFM file, when you open the form again, you will see that it cannot find the relevant Class and an error occurs.
To change the DFM flow, I first assigned a value to the "PropertiesClassName" Property and then created the Class, but the problem was not solved. I did the opposite of this but the problem is still the same.
DFM Context
object QuerySearchEngine1: TQuerySearchEngine
SearchFields = <
item
FieldName = 'TestField'
Properties.Convert2String = True
PropertiesClassName = 'TSearchBooleanProperties'
end>
DFM Context should be like
object QuerySearchEngine1: TQuerySearchEngine
SearchFields = <
item
PropertiesClassName = 'TSearchBooleanProperties'
FieldName = 'TestField'
Properties.Convert2String = True
end>
Classes
TSearchField = class(TCollectionItem)
private
FFieldName: string;
FProperties: TSearchFieldProperties;
FPropertiesClassName: string;
private
procedure SetFieldName(const Value: string);
procedure SetProperties(const Value: TSearchFieldProperties);
private
procedure ReaderProc(Reader: TReader);
procedure WriterProc(Writer: TWriter);
procedure SetPropertiesClassName(const Value: string);
protected
constructor Create(Collection: TCollection); override;
procedure DefineProperties(Filer: TFiler); override;
public
property PropertiesClassName: string read FPropertiesClassName write SetPropertiesClassName;
published
property FieldName: string read FFieldName write SetFieldName;
property Properties: TSearchFieldProperties read FProperties write SetProperties;
end;
procedure TSearchField.DefineProperties(Filer: TFiler);
begin
inherited;
Filer.DefineProperty('PropertiesClassName', ReaderProc, WriterProc, FPropertiesClassName <> '');
end;
procedure TSearchField.SetPropertiesClassName(const Value: string);
begin
var Item: TSearchFieldPropertiesItem;
if TryValidateSearchFieldPropertiesClassName(Value, Item) then
begin
if not Assigned(FProperties) or not (FProperties.ClassType = Item.ClassType) then
begin
if Assigned(FProperties) then
begin
FProperties.Free;
FProperties := nil;
end;
FPropertiesClassName := Item.ClassType.ClassName;
FProperties := Item.ClassType.Create;
end;
end
else
begin
FPropertiesClassName := '';
if Assigned(FProperties) then
begin
FProperties.Free;
FProperties := nil;
end;
end;
end;
Property Editor
type
TSearchFieldPropertiesProperty = class(TClassProperty)
private
function GetInstance: TPersistent;
public
function GetAttributes: TPropertyAttributes; override;
procedure GetValues(Proc: TGetStrProc); override;
function GetValue: string; override;
procedure SetValue(const Value: string); override;
end;
function TSearchFieldPropertiesProperty.GetValue: string;
begin
for var I := 0 to Self.PropCount - 1 do
begin
var Inst := Self.GetComponent(I);
if Assigned(Inst) and Self.HasInstance(Inst) then
begin
if Inst is TSearchField then
begin
var PropInst := GetObjectProp(Inst, Self.GetPropInfo);
if Assigned(PropInst) then
begin
for var Item in SearchFieldPropertiesList do
begin
if PropInst.ClassType = Item.ClassType then
begin
Result := Item.Name;
Exit;
end;
end;
end;
end;
end;
end;
end;
procedure TSearchFieldPropertiesProperty.SetValue(const Value: string);
begin
var Item: TSearchFieldPropertiesItem;
if TryValidateSearchFieldPropertiesName(Value, Item) then
begin
var Inst := GetInstance;
if Assigned(Inst) then
begin
var Context := TRttiContext.Create;
var Rtype := Context.GetType(Inst.ClassType);
for var Prop in Rtype.GetProperties do
begin
if SameText(Prop.Name, 'PropertiesClassName') then
begin
Prop.SetValue(Inst, TValue.From<string>(Item.ClassType.ClassName));
Break;
end;
end;
end;
end;
end;
Pic for Design Time
The only problem is changing the order of the Property in that DFM flow.
Original answer at the bottom, here is a new suggestion:
We actually have something very similar in the JVCL where TJvHotTrackPersistent publishes a HotTrackOptions property.
This property is backed by an instance of TJvHotTrackOptions that gets derived in other classes that need specialized versions of it.
To tell the streaming subsystem to use the actual class found at streaming time, the constructor of that options class calls SetSubComponent(True); which places csSubComponent in the ComponentStyle property.
So what you should do is get rid of your DefineProperties, have TSearchFieldProperties inherit from TComponent and call SetSubComponent(True) in its constructor.
Then you create as many classes derived from TSearchFieldProperties as you need, each with its own set of published properties.
This means you should also get rid of the methods you showed in your submission.
In the end, you should have something along those lines:
type
TSearchFieldProperties = class(TComponent)
public
constructor Create(AOwner: TComponent); override;
end;
TIntegerSearchFieldProperties = class(TSearchFieldProperties)
private
FIntValue: Integer;
published
property IntValue: Integer read FIntValue write FIntValue;
end;
constructor TSearchFieldProperties.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
SetSubComponent(True);
end;
With this you do not fight against the streaming system but rather work with it in the way it is meant to be used.
But if you stop there, you'll notice there is no way for you to specify the actual class name to be used for the TSearchFieldProperties instance used for the TSearchField.Properties property.
The only way to get the class name to be streamed before the subcomponent is streamed is to actually declare the class name as a published property, declared before the subcomponent like this:
type
TSearchField = class(TCollectionItem)
published
// DO NOT change the order of those two properties, PropertiesClassName must come BEFORE Properties for DFM streaming to work properly
property PropertiesClassName: string read GetPropertiesClassName write SetPropertiesClassName;
property Properties: TSearchFieldProperties read FProperties write SetProperties;
end;
function TSearchField.GetPropertiesClassName: string;
begin
Result := Properties.ClassName;
end;
procedure TSearchField.SetPropertiesClassName(const AValue: string);
begin
FProperties.Free; // no need to test for nil, Free already does it
FProperties := TSearchFieldPropertiesClass(FindClass(AValue)).Create(self);
end;
It might work if you just declare the published property like without creating a csSubComponent hierarchy but you'll most likely stumble on other hurdles along the way.
Note: this answer is wrong because DefineProperties is called last in TWriter.WriteProperties and so there is no way to change the order properties defined like this are written.
What if you change your DefineProperties override from this:
procedure TSearchField.DefineProperties(Filer: TFiler);
begin
inherited;
Filer.DefineProperty('PropertiesClassName', ReaderProc, WriterProc, FPropertiesClassName <> '');
end;
to this:
procedure TSearchField.DefineProperties(Filer: TFiler);
begin
Filer.DefineProperty('PropertiesClassName', ReaderProc, WriterProc, FPropertiesClassName <> '');
inherited DefineProperties(Filer);
end;
Basically, call the inherited method AFTER you have defined your own property.
Note that I also specified which inherited method is called. I know it's not required, but it makes intent clearer and allows for Ctrl-Click navigation.

Cannot change TEdit Text in Delphi

I am adding components to a form at run time and I am also adding events that change properties of these components in a dictionary to call them later.
TEventBeforeInsert = function(var AComponent: TComponent; AForm: TForm): Boolean of Object;
TFieldBase = class
private
FEvent:TEventBeforeInsert;
....
function TFieldBase.EventBeforeInsert: TEventBeforeInsert;
begin
Result:=FEvent;
end;
function TFieldBase.EventBeforeInsert(AEvent: TEventBeforeInsert): TFieldBase ;
begin
FEvent:=AEvent;
Result:=Self;
end;
....
The Form Call
TFormBase.New
.addStringField
(
TFieldBase.New
.Enabled(True)
.Description('User')
.EventBeforeInsert(TEvents.New.EditFillUser), TTabsNames.Tab1
).Show();
The Form Class
TFormBase = class(TForm)
private
FDictionary: TDictionary<String, TEventBeforeInsert>;
...
function TFormBase.addStringField(AField: TFieldBase; ATab: TTabsNames): TFormBase;
var
FLink: TLinkControlToField;
FEdit: TEdit;
begin
Result := Self;
FEdit := TEdit.Create(Self);
FEdit.Visible := True;
FEdit.Parent := TPanel(PanelParent.FindComponent('PanelTab' + Ord(ATab).ToString));
FEdit.Enabled:=AField.Enabled;
if Assigned(AField.EventBeforeInsert) then
begin
FDictionary.Add(FEdit.Name,AField.EventBeforeInsert);
end;
end;
...
procedure TFormBase.rectInsertClick(Sender: TObject);
var
Item:String;
begin
for Item in FDictionary.Keys do
begin
if Not FDictionary.Items[Item](Self.FindComponent(Item),Self) then
Exit;
end;
end;
I'm having a problem here, when debugging I see the text property being changed correctly, but no changes are made to the form being displayed.
TEvents = class
...
function TEvents.EditFillUser(AComponent: TComponent;AForm: TForm): Boolean;
begin
TEdit(AComponent).Text:=IntToStr(0);
Result:=True;
end
I'm thinking it may be a problem that the variable is being passed by value ... Can someone help me?
Edit 1:
I've tried with the dictionary declared like this:
FDictionary: TDictionary<TComponent, TEventBeforeInsert>;
...
if Not FDictionary.Items[Item](Item,Self) then //call
And I also tried use TForm reference like this:
function TEvents.EditFillUser(AComponent: String;AForm: TForm): Boolean;
begin
TEdit(AForm.FindComponent(AComponent)).Text:=IntToStr(0);
Result:=True;
end
In TFormBase.addStringField(), you are not assigning a Name value to the newly create TEdit object before inserting it into FDictionary.. Only components created at design-time have auto-generated Names. Components created at run-time do not. So, you are tracking your objects using blank Names. If you want to track the objects by Name, you need to actually assign your own value to FEdit.Name, eg:
function TFormBase.addStringField(AField: TFieldBase; ATab: TTabsNames): TFormBase;
var
...
FEdit: TEdit;
FEvent: TEventBeforeInsert;
begin
...
FEdit := TEdit.Create(Self);
FEdit.Name := 'SomeUniqueNameHere'; // <-- for you to decide on...
...
FEvent := AField.EventBeforeInsert;
if Assigned(FEvent) then
FDictionary.Add(FEdit.Name, FEvent);
end;
However, in this particular case, I see no reason to use a TDictionary at all. Consider using a TList instead, then you don't need the Names at all. This will also boost the performance of the iteration in TFormBase.rectInsertClick() since it won't have to hunt for every TComponent object using FindComponent() anymore:
TFormBase = class(TForm)
private
type TEventBeforeInsertPair = TPair<TComponent, TEventBeforeInsert>;
FBeforeInsertEvents: TList<TEventBeforeInsertPair>;
...
public
constructor Create;
destructor Destroy; override;
...
end;
...
constructor TFormBase.Create;
begin
inherited;
FBeforeInsertEvents := TList<TEventBeforeInsertPair>.Create;
end;
destructor TFormBase.Destroy;
begin
FBeforeInsertEvents.Free;
inherited;
end;
function TFormBase.addStringField(AField: TFieldBase; ATab: TTabsNames): TFormBase;
var
...
FEdit: TEdit;
FEvent: TEventBeforeInsert;
begin
...
FEdit := TEdit.Create(Self);
...
FEvent := AField.EventBeforeInsert;
if Assigned(FEvent) then
FBeforeInsertEvents.Add(TEventBeforeInsertPair.Create(FEdit, FEvent));
end;
procedure TFormBase.rectInsertClick(Sender: TObject);
var
Item: TEventBeforeInsertPair;
begin
for Item in FBeforeInsertEvents do
begin
if not Item.Value(Item.Key, Self) then
Exit;
end;
end;
...
Also, your TEvents.EditFillUser() method does not match the definition of TEventBeforeInsert. The 1st parameter of TEventBeforeInsert is declared as passing the TComponent pointer by var reference (why?), but the 1st parameter of EditFillUser() is not doing that. Unless you want your event handlers to alter what the TComponent pointers are pointing at (which won't work the way you are currently using TEventBeforeInsert with TDictionary), then there is no reason to pass around the TComponent pointers by var reference at all:
TEventBeforeInsert = function(AComponent: TComponent; AForm: TForm): Boolean of Object;
Also, your use of TEvents.New appears to be a memory leak, as nobody is taking ownership of the newly created TEvents object (unless its constructor is adding the object to some internal list that we can't see). Same with TFieldBase.New. And even TFormBase.New (assuming there is no OnClose event that sets Action=caFree when the Form is closed). At some point, you need to call Free() any class object that you Create().

How can I prevent duplication of sub components in Firemonkey compound component?

I am trying to write a compound component which is derived from TDummy. The component source is:
TMyObjectType=(otCube,otSphere);
TMyGameObject=class(TDummy)
private
FObj:TCustomMesh;
FMyObjectType: TMyObjectType;
procedure SetMyObjectType(const Value: TMyObjectType);
public
constructor Create(AOwner:TComponent);override;
destructor Destroy;override;
property MyObjectType:TMyObjectType read FMyObjectType write SetMyObjectType;
end;
{ TMyGameObject }
constructor TMyGameObject.Create(AOwner: TComponent);
begin
inherited;
MyObjectType:=otCube;
end;
destructor TMyGameObject.Destroy;
begin
FObj.Parent.RemoveObject(FObj);
FreeAndNil(FObj);
inherited;
end;
procedure TMyGameObject.SetMyObjectType(const Value: TMyObjectType);
begin
FMyObjectType := Value;
if(Assigned(FObj))then begin
FObj.Parent.RemoveObject(FObj);
FreeAndNil(FObj);
end;
case FMyObjectType of
otCube: FObj:=TCube.Create(Self);
otSphere: FObj:=TSphere.Create(Self);
end;
FObj.SetSubComponent(True);
FObj.Parent:=Self;
end;
after I register the component and put one instance on a TViewport3D in the code of a Tbutton I try to change the MyObjectType to otSphere.
MyGameObject1.MyObjectType:=otSphere;
but it seems there is nothing happening. So I wrote a piece of code as fallow.
procedure MyParseObj(obj:TFmxObject;var s:string);
var
i: Integer;
a:string;
begin
s:=s+obj.ClassName+'(';
a:='';
for i := 0 to obj.ChildrenCount-1 do begin
s:=s+a;
MyParseObj(obj.Children.Items[i],s);
a:=',';
end;
s:=s+')'
end;
and call it in another button.
procedure TForm1.Button2Click(Sender: TObject);
var s:string;
begin
s:='';
MyParseObj(myGameObject1,s);
ShowMessage(s);
end;
the result was strange.
if I press the button2 result is: TMyGameObject(TCube(),TCube())
and when I press the button1 and after that press button2 result is: TMyGameObject(TCube(),TSphere())
why there is two TCustomMesh as child in my object? (TCube and TSphere are derived from TCustomMesh)
how can I fix this?
and there is another test that I performed. if I create the object not in design time it work properly. problem happens if I put an instance of TMyGameObject in design time.
When you save a form (from the IDE) all controls and all their children are saved. If your control creates it's own children then you need to set Stored = False to prevent them being streamed by the IDE.

Delphi 2010 Can I have a TFrame with Generic properties and methods to pass an event?

I have a TFrame that I use for searching for entities in a Delphi 2010 VCL project, in the TFrame I have a button edit, that allows the user to open a specific form to browse for that entity. (All the browse forms inherit from a common base browse form)
Currently I achieve this by inheriting from the base frame, then implement the Browse event that fires off the specific form. The only difference each time is what form (type) is shown on the click event, is there a way I can achieve this with generics.
That way I can reuse the same base frame without having to rewrite the same code for each entity (there are over 100), and at form create of the host form pass the type constraint to open the appropriate form on browse.
I have tried adding a generic type to the frame:
type
Browser<T: TfrmBrowser, constructor> = class
class function BrowseForm(Owner: Tcomponent): T;
end;
class function Browser<T>.BrowseForm(Owner: Tcomponent): T;
var
_browseForm: T;
begin
_browseForm := T.Create; // 1st problem T.Create(Owner); throws a comile error
Result := _browseForm;
end;
and then in the picker frame I expose Start that can be called from the the host form's create event:
procedure TPickerFrame.Start<T>(const idProp, nameProp, anIniSection: string; aDto: IDto);
begin
_browseForm:= Browser<T>.BrowseForm(self);
_iniSectionName:= anIniSection;
_idField:= idProp;
_descriptionField:= nameProp;
_dto := aDto;
end;
the truth is, I don't really get generics in Delphi, and none of this is working.
Below are excerpts from the frame:
_browseForm: TfrmBrowser;
procedure TPickerFrame.Browse(var DS: TDataSet; var Txt: string; var mr: TModalResult);
begin
// How do I achieve this with Generics
// _browseForm := T.Create(nil); // <-- this line is what needs to know the form type at runtime
// Everything else from here is the same
_browseForm.ProductName := Application.Title;
_browseForm.PageSize := 20;
_browseForm.DatabaseType := bdbtADO;
_browseForm.ADOConnection := dmdbWhereHouse.BaseADOConnection;
_browseForm.INISectionName := _iniSectionName;
_browseForm.DoSelBrowse(DS, Txt, mr, _descriptionField, _text);
if mr = mrOk then
begin
DoSelect(DS);
end;
end;
Does anyone have any experience with a similar requirement? Any help would be appreciated.
Thanks
Below is an example of the rack master browser:
type
TfrmMbfRACK_MASTER = class(TMxfrmBrowseHoster)
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
//...
private
FWHID: Integer;
procedure SetWHID(const Value: Integer);
{ Private declarations }
public
{ Public declarations }
procedure BuildADO(Sender: TObject; Q: TADOQuery); override;
end;
implementation
{$R *.DFM}
{ TfrmMbfRACK_MASTER }
procedure TfrmMbfRACK_MASTER.FormCreate(Sender: TObject);
begin
inherited;
fmeMxFrmBrowseHoster1.KeyField := 'RACK_ID';
// FWHID := -2; // 22/06/04
FWHID := 0; // 22/06/04
end;
procedure TfrmMbfRACK_MASTER.BuildADO(Sender: TObject; Q: TADOQuery);
begin
Q.Close;
Q.SQL.Clear;
Q.SQL.Add(
'SELECT R.RACK_DESC, R.RACK_BARCODE, W.ERP_WH, WC.CLASS_NAME, W.DESCRIPTION WAREHOUSE, R.RACK_PACKING_ORDER, ');
//...
end;
The base class
type
TMxfrmBrowseHoster = class(TfrmMxForm)
protected
// ...
procedure FormCreate(Sender: TObject);
procedure BuildADO(Sender: TObject; ADOQ: TADOQuery); virtual; abstract;
public
procedure TMxfrmBrowseHoster.FormCreate(Sender: TObject);
begin
TMxFormProductName := Application.Title;
fmeMxFrmBrowseHoster1.Initialise;
INISectionName := Name;
AbortAction := False;
fmeMxFrmBrowseHoster1.OnSelect := SelectNormaliser;
fmeMxFrmBrowseHoster1.OnNeedADO := BuildADO;
fmeMxFrmBrowseHoster1.INISectionName := self.Name;
fmeMxFrmBrowseHoster1.MultiSelect := dxBarLargeButton10.Down;
fmeMxFrmBrowseHoster1.AutoSaveGrid := True;
dxBarEdit1.OnChange := ActPageSizeChangedExecute;
FormStorage.RestoreFormPlacement;
ActConfirmDelete.Execute;
end;
I find your question a little on the vague side and I'm not 100% sure I understand exactly what you are asking. However, I know how to deal with your problem when calling the constructor. Perhaps that's all you need help with.
You need to use virtual constructor polymorphism and a bit of casting:
class function Browser<T>.BrowseForm(Owner: Tcomponent): T;
var
_browseForm: T;
begin
_browseForm := TfrmBrowser(T).Create(Owner);
Result := _browseForm;
end;
This relies on virtual constructor polymorphism. So you must make sure that each constructor for every class derived from TfrmBrowser is marked with the override directive.

extract an object from a TObjectList

I have a TObjectList with OwnsObjects = true. It contains quite a few objects. Now I want to remove the object at index Idx from that list, without freeing it.
Is the Extract method the only option?
ExtractedObject := TheList.Extract(TheList[Idx]);
All other methods seem to free the object. I am looking for something a little bit more efficient, that does not do a linear search every time, since I already know the index of the object. Something like an overloaded ...
ExtractedObject := TheList.Extract(Idx);
... which does not exist.
Why not just set OwnsObjects to false, do your removal, then set it to true again?
If you look at the code for delete, it's the notify method which causes the freeing to happen.
This should work :
TMyObjectList = Class(TObjectList)
private
fNotify: Boolean;
{ Private declarations }
procedure EnableNotification;
procedure DisableNotification;
protected
procedure Notify(Ptr: Pointer; Action: TListNotification); override;
public
constructor Create(AOwnsObjects: Boolean);overload;
constructor Create; overload;
function Extract(const idx : Integer) : TObject;
end;
constructor TMyObjectList.Create(AOwnsObjects: Boolean);
begin
inherited Create(AOwnsObjects);
fNotify := True;
end;
constructor TMyObjectList.Create;
begin
inherited Create;
fNotify := True;
end;
procedure TMyObjectList.DisableNotification;
begin
fnotify := False;
end;
procedure TMyObjectList.EnableNotification;
begin
fNotify := True;
end;
function TMyObjectList.Extract(const idx: Integer) : TObject;
begin
Result := Items[idx];
DisableNotification;
try
Delete(idx);
finally
EnableNotification;
end;
end;
procedure TMyObjectList.Notify(Ptr: Pointer; Action: TListNotification);
begin
if fNotify then
inherited;
end;
This is where class helpers can be usefull
TObjectListHelper = class helper for TObjectList
function ExtractByIndex(const AIndex: Integer): TObject;
end;
function TObjectListHelper.ExtractByIndex(const AIndex: Integer): TObject;
begin
Result := Items[AIndex];
if Result<>nil then
Extract(Result);
end;
You can now use:
MyObjList.ExtractByIndex(MyIndex);
The proposed helperclass (by Gamecat) will result in the same lookup that Thomas would like to get rid of.
If you take a look at the source, you can see what Extract() really does, and then use the same approach.
I will suggest something like tis:
obj := list[idx];
list.list^[idx] := nil; //<- changed from list[idx] := nil;
list.delete(idx);
This will give you the object, as Extract() does, and then delete it from the list, without any lookups. Now you can put this in a method some where, a helperclass or subclass or wher ever you like.
I don't use Delphi/C++Builder some time ago, but as far as I can renmember thats the only way.
My suggestion is to use a TList instead, and manually delete the objects when required.
Anything wrong with:
ExtractedObject := TExtractedObject.Create;
ExtractedObject.Assign(Thelist[Idx]);
TheList.Delete(idx);
There is time needed for the create and assign but not for the search of the list. Efficiency depends on the size of the object -v- the size of the list.

Resources