Delphi: How to allow setting a TClass-property of a TCollectionItem at design time - class

I'm developing a component that works on several classes.
In order to allow adding the list of managed classes, I've written a TCollection's inherited class in which each item (inherited from TCollectionItem) defines a published "TargetClassName" property.
The "TargetClassName" property's setter function, calls the following function in order to find the corrisponding TClass:
function FindAnyClass(const Name: string): TClass;
var
ctx: TRttiContext;
typ: TRttiType;
list: TArray<TRttiType>;
begin
Result := nil;
ctx := TRttiContext.Create;
list := ctx.GetTypes;
for typ in list do
begin
if typ.IsInstance and (EndsText(Name, typ.Name)) then
begin
Result := typ.AsInstance.MetaClassType;
break;
end;
end;
ctx.Free;
end;
(Thanks to Dalija Prasnikar for writing the function Get class by its name in Delphi).
Now, I'm wondering if there's a better way to allow adding classes to a TCollectionItem at design time.. What do you think about it?
Hope to read interesting solutions!
Thanks to all.

in creation on TCollection You need To introduce Collation Class
it's Posible in two way
1 : hard coded in create time X := TMycollation.Create(TMyCollationClass)
2 : your solution X := TMycollation.Create(FindAnyClass('TMyCollationClass'));

Related

ShowModal for an associated form

I have a component with bellow properties:
property Form: TForm read FForm write SetForm
property BtnOK: TButton read FBtnOK write SetBtnOK
and a procedure behind like this:
procedure Execute_FormShowModal;
I would like to open the associated form (eg. FormUser) when the Execute_FormShowModal is executed.
I would like to mention that, the associated form is already defined and exist, but is not created.
Is there any possibility to do this?
procedure TMyComp.Execute_FormShowModal;
var
frm: TForm;
begin
frm:= TForm(FForm.ClassName).Create(FParentForm); //Access Violation...
//... here I would like to play also this the elements from this form
//like: BtnOK.Enabled:= False;
frm.ShowModal;
frm.Free;
end;
You added in the comments that you are setting FForm to be equal to a valid existing form. If so, you may not need to create anything:
procedure TMyComp.Execute_FormShowModal;
var
frm: TFormUser;
begin
frm:= TFormUser(FForm);
frm.BtnOK.Enabled:=False;
frm.ShowModal;
//frm.Free;
end;
This assumes that this valid instance you are referring to is declared
type
TFormUser = class(TForm)
BtnOK : TButton;
// etc...
end;
If you trying to make a copy of the form you might use this:
procedure TMyComp.Execute_FormShowModal;
var
frm: TFormUser;
begin
frm:= TFormUser(TFormClass(FForm.ClassType).Create(FParentForm));
// which is no different than:
frm:= TFormUser.Create(FParentForm));
frm.BtnOK.Enabled:=False;
frm.ShowModal;
frm.Free;
end;
If you want to manipulate the controls on the form (i.e. BtnOK), then you need to know the class type of the Form (TFormUser in this case). So it is contradictory to be required to know the exact class type of the form and yet want to instanciate a form from a design-time established type.
Since you may be trying to instanciate the form without "knowing" its absolute type, your FForm property should be the class for the form.
Assuming you weren't publishing the "Form" property in your component, I would make these changes to your component:
TMyComp = class(TComponent)
FFormClass : TFormClass;
procedure SetFormClass(Value : TFormClass);
property FormClass: TFormClass read FFormClass write SetFormClass;
procedure Execute_FormShowModal;
end;
The initialization code you referred to might look like this:
begin
// .....
//MyComp.Form := FormUser1;
MyComp.FormClass := TFormUser;
// .....
end;
And then "Execute_FormShowModal" becomes:
procedure TMyComp.Execute_FormShowModal;
var
frm: TForm;
begin
// Check that FFormClass is not nil and perform some alternate
// action.
// if FFormClass = nil then ......
//
frm:= FFormClass.Create(FParentForm);
frm.ShowModal;
frm.Free;
end;
Of course, you may also want to add some code to check if FFormClass is nil and preform some alternate behavior if so, like raise an exception or showing some message or even instanciating a default form.
If you were publishing the Form property then it won't be able to handle the case where your FForm field value is nil because you don't know or have a specific class type to instanciate the Form. That is:
frm:= TFormClass(FForm.ClassType).Create(FParentForm);
will simply display a blank, empty form.
If you want to publish this property, you could try making it a string type that carries the name of the form class you want to instanciate and then use RTTI to find the class:
uses RTTI;
TMyComp = class(TComponent)
FFormClassName : string;
procedure SetFormClassName(const Value : string);
property FormClassName: string read FFormClassName write SetFormClassName;
procedure Execute_FormShowModal;
end;
procedure TMyComp.Execute_FormShowModal;
var
frmCls : TFormClass;
frm: TForm;
RTTI : TRTTIContext;
RTTIType : TRTTIType;
begin
frmCls := nil;
for RTTIType in RTTI.GetTypes do
begin
if (RTTIType.Name = FFormClassName) and (RTTIType.TypeKind = tkClass) then
begin
if RTTIType.Handle.TypeData.ClassType.InheritsFrom(TForm) then
begin
frmClass := TFormClass(RTTIType.Handle.TypeData.ClassType);
break;
end;
end;
end;
// Check that frmCls is not nil and perform some alternate
// action.
// if frmCls = nil then ......
//
frm:= frmCls.Create(FParentForm);
frm.ShowModal;
frm.Free;
end;
Is there any possibility to do this?
Yes
Try something like this
uses uFForm; // Add the unit name that defined the associated form to your (TMyComp) unit uses clause
procedure TMyComp.Execute_FormShowModal;
begin
with TFForm.Create(Self) do //TFForm is the child form
begin
//... here I would like to play also this the elements from this form
BtnOK.Enabled:= False;
Show;
end;
end;
First problem is that you are trying to typecast the ClassName to a class type that you're trying to instantiate. Instead you want to work with the metaclass that can be obtained by the ClassType method from an object instance. The next issue is that with such metaclass you need to typecast to a metaclass, not to a class, so instead of typecasting to TForm class cast to its metaclass TFormClass.
To the next part of your question, if you can generally access a specific class members of an object that is declared as a common class ancestor, no, that is not possible. As a workaround you must determine the object class type and access it by typecasting to that class, or use RTTI which is more difficult.
Try something like this:
procedure TMyComp.Execute_FormShowModal;
var
frm: TForm;
begin
frm := TFormClass(FForm.ClassType).Create(FParentForm);
{ to acess the class specific members you will have to typecast to a
specific class (or use RTTI, which is even more difficult) }
if frm is TMyForm then
TMyForm(frm).BtnOK.Enabled := False;
frm.ShowModal;
frm.Free;
end;

Delphi, find form by name

how can I find form by name? On this form I have Edit (TEdit) and i would like to write something in this TEdit (its name e.g.: adress) but I have only form name.
Can you help me?
There is a simpler way of finding a form by name. Since all of auto-created form objects become owned by Application object and TApplication inherits from TComponent, you can either iterate thru Application.Components array property or use Application.FindComponent method.
var
Form: TForm;
begin
Form := Application.FindComponent('LostForm1') as TForm;
if Assigned(Form) then
Form.Show
else
{ error, can't find it }
Note that FindComponent is case-insensitive.
This answer assumes you are making a VCL application. I don't know if FireMonkey has a similar solution.
All forms are added to the global Screen (declared in Vcl.Forms) object when they are created. Thus you can make a little helper function like this
function FindFormByName(const AName: string): TForm;
var
i: Integer;
begin
for i := 0 to Screen.FormCount - 1 do
begin
Result := Screen.Forms[i];
if (Result.Name = AName) then
Exit;
end;
Result := nil;
end;
You can use the FindWindow function if you know the form title or the class name of the form.

How to copy data from one class into another class

how to copy data from one class into a second class using operator overloading with DELPHI ?
my dummy app goes like this :
type
TClass_A = class
a: String;
end;
TClass_B = class(TClass_A)
b: String;
end;
implementation
procedure TForm1.Button1Click(Sender: TObject);
var
a: TClass_A;
b: TClass_B;
begin
a := TClass_A.Create;
b := TClass_B.create;
b := a; // <<-- What code should be here? Can I overload := operator?
end;
The assignment operator cannot be overloaded in Delphi.
You will need to introduce a method to perform the copying. An example of how this might be done is TPersistent.Assign. It would be perfectly reasonable for you to derive from TPersistent and override the virtual Assign method to implement the desired functionality.
Here is a small example of how to do this with new style RTTI (D2010 and higher).
Please note that this is a very basic example which only copies fields (not properties) and works best with basic classes (do not use this with TComponent), the fields in the destination object must be the same type. FYI, there are better examples out there :)
uses
Rtti,...
function CopyObject(const FromObj, ToObj: TObject): Boolean;
var
Ctx : TRTTIContext;
FromObjType : TRttiType;
ToObjType : TRttiType;
FromField : TRttiField;
ToField : TRttiField;
begin
Result := False;
FromObjType := Ctx.GetType(FromObj.ClassInfo);
ToObjType := Ctx.GetType(ToObj.ClassInfo);
for FromField in FromObjType.GetFields do
begin
ToField := ToObjType.GetField(FromField.Name);
if Assigned(ToField) then
begin
if ToField.FieldType = FromField.FieldType then
ToField.SetValue(ToObj, FromField.GetValue(FromObj));
Result := True;
end;
end;
end;

Error When Editing Member Variable in Class

I'm trying to use a class in my program.
TStack = Class
Public
constructor Create; Overload;
Procedure Add(Frm:TForm);
Procedure Remove();
Procedure Do_Close;
Private
List : Array[1..Max_Forms] of Rec;
Count : Byte;
End;
Constructor:
constructor TStack.Create;
begin
Self.Count := 0;
end;
Procedure TStack.Add(Frm:TForm);
begin
Inc(Self.Count);
List[Count].Form := #Frm;
List[Count].Width := Frm.Width;
List[Count].Height := Frm.Height;
List[Count].left := Frm.Left;
List[Count].Top := Frm.Top;
end;
I can't change value of Count variable! It cause Run-Time error : Access violation....Write of address 000001E4
What's the problem?!
FOR MORE INFORMATION:
I'm trying to store a pointer to each form in a structure like this :
Rec = Record
Form : ^TForm;
Maximized : Boolean;
Width,
Height,
left,
Top : Integer;
End;
And then
Procedure TStack.Do_Close;
var
i : integer;
MyForm : TForm;
begin
i := .....some code here.......;
MyForm := #List[i].Form;
ShowMessage('I will close '+MyForm.Caption);
MyForm.Close;
end;
AND call constructor like this to initialize 'Count':
Stack.Create;
As described in comments you are attempting to create the object like this:
var
Stack: TStack;
....
Stack.Create;
This is a classic mistake, and one that we've all made. You are calling a method on an uninitialized instance variable.
In order to instantiate a class you need to write this:
Stack := TStack.Create;
On top of that I have the following comments:
Use zero-based indexing for arrays. That's the convention everywhere in Delphi apart from anachronistic strings. And even that is changing in newer versions.
Don't use static arrays for a stack unless you have a good reason for doing so. You'll just run the risk of running out of space. Or allocating more memory than you need. Use a dynamic array.
Rather than a dynamic array, you could use TList<T>.
Even so, one wonders why you are making your own stack class when there is the perfectly good TStack<T>.
You store the address of a local variable in your stack. In TStack.Add you add #Frm into the container. As soon as TStack.Add returns, #Frm is meaningless. That's because Frm is a local variable whose life ends when the function that owns it returns. I think you want to take a copy of Frm.
Picking up item 5 in more detail, your record is declared like this:
Rec = Record
Form : ^TForm;
Maximized : Boolean;
Width,
Height,
left,
Top : Integer;
End;
It is a mistake to use ^TForm. That is a pointer to a variable holding a pointer to an object. That's two levels of indirection, one too many. You must declare the Form field to be of type TForm. I suggest you revise the way Delphi object reference variables work. Delphi classes are what is known as reference types. A variable of type TMyClass where TMyClass is class(...) is already a pointer. The language automatically de-references the pointer when you use the . operator to access members.

Free Pascal multiple interfaces problem

This may prove difficult -- I'm using multiple CORBA interfaces on an object, so it looks somehow like this:
TBaseObject = class(TSuperBaseObject, IInterfaceA)
function Afunction; // implemented from IInterfaceA
end;
TOtherObject = class(TBaseObject, IInterfaceB);
function Bfunction; // implemented from IInterfaceB
end;
Now I have a function that takes a variant, and in case that variant is an object, it assumes that object to be a IInterfaceA object:
case var.vtype of
...
vtObject : begin
Something := (var.vObject as IInterfaceA).AFunction; (1)
end;
end;
Now once I run that code, and pass a TOtherObject to the function, in line (1) BFunction gets called with forced parameters!
Am I doing something wrong or is it a bug in the compiler? Also, any sane way to circumvent that without changing the class structure?
Full code for a EAccessViolation if anyone wants to try - http://pastebin.com/D7sDpDHx
Reported this as a bug to the FPC bugtracker - http://bugs.freepascal.org/view.php?id=20076
It turned out that FPC doesn't identify CORBA interfaces internally. To solve the problem one needs to identify them by himself:
type IInterfaceA = interface['interface_a']
function AFunction;
end;
Then the as keyword will work.
Not sure about FreePascal, but in Delphi you would use the supports function to query the interface.
var
IntfA : IInterfaceA;
IntfB : IInterfaceB;
begin
case var.vtype of
...
vtObject : begin
if supports(var.vObject,IInterfaceA,IntfA) then
Something := IntfA.AFunction
else if supports(var.vObject,IInterfaceB,IntfB) then
Something := IntfB.BFunction;
end;
end;
end;