Free Pascal multiple interfaces problem - interface

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;

Related

Destroy a class instance on creating the new instance

I am programming an MDIChild form in Delphi with the Action = caFree in OnClose event. Now I want that at one time there will only be one instance of a form. For this I used a class variable:
type
TMyForm = class(TForm)
...
class var CurInstance: TMyForm;
...
end;
constructor TMyForm.Create();
begin
inherited Create(nil);
if Assigned(TMyForm.CurInstance) then
TMyForm.CurInstance.Destroy
TMyForm.CurInstance := Self;
end;
destructor TMyForm.Destroy();
begin
TMyForm.CurInstance := nil;
inherited Destroy;
end;
The code above works pretty well and does what it should be. But I have a bad feeling about calling destructor from constructor, even through this is a different instance. Is this a correct way? Is there something else I need to consider about this?
Many thanks.

Delphi classes and methods. Need one method implementation for multiple classes

So, for example, I have classes of vegetables for a farm.
TVegetable = class
TCarrot = class(TVegetable)
TTomato = class(TVegetable)
I need two different classes of each vegetable, one for supermarkets and another for factories.
TCarrotSupermarket = class(TCarrot)
TCarrotFactory = class(TCarrot)
These classes are identical except the code for one method:
procedure Utilization;
TCarrotSupermarket.Utilization works with supermarkets, TCarrotFactory.Utilization works with factories.
One identical code for Utilization I need for
TCarrotSupermarket.Utilization, TTomatoSupermarket.Utilization, TPotatoSupermarket.Utilization, and another code for
TCarrotFactory.Utilization, TTomatoFactory.Utilization, TPotatoFactory.Utilization.
What is the best way to write code for Utilization only twice (for supermarkets and factories) and use it in a proper classes?
Welcome to Pattern Design. Your case is Strategy patternn
class TStrategyVegetable = class(TVegetable)
FUtil: TUtilization
public
procedure Create(util: TUtilization);
procedure Utilization();
end
procedure TStrategyVegetable.Create(util: TUtilization)
begin
FUtil := util
end
procedure TStrategyVegetable.Utilization;
begin
FUtil.Utilization;
end
Then in code:
carrotSupermarket = TCarrotSupermarket.Create(TCarrotSupermarketUtil.Create);
carrotFactory = TCarrotFactory.Create(TCarrotFactoryUtil.Create);
Here's some pseudo code getting to a solution with using interface method resolution. (Untested, not even compiled, but it should point you in the right direction)
IFactoryInterface=interface(IUnknown) ['{someGUID}']
procedure Utilization;
end;
ISuperMarketInterface=interface(IUnknown) ['{AnotherGUID}']
procedure Utilization;
end;
TVegetable = class (TSomeObject,IFactoryInterface,ISupermarketInterface)
protected
// the routines tha do the actual implementation
// can be regular virtual, dynamic, or whatever
procedure FactoryUtilization;
procedure SuperMarketUtilization;
// link up the interfaces using method resolution
procedure IFactoryInterface.Utilization=FactoryUtilization;
procedure ISupermarketInterface.Utilization=SuperMarketUtilization;
{ in case not derived from TInterfacedObject,
You'll have to add _AddRef,_Release and
QueryInterface methods too }
end;
// the other implementations can be as before
TCarrot = class(TVegetable)
TTomato = class(TVegetable)
Then when using the code it should look something like this:
VAR lSOmeVegetable,lAnotherVegetable:TVegetable;
...
lSomeVegetable:=TCarrot.Create
lanotherVegetable:=Tomato.Create
...
// call using buolt-in type checking
(lSOmeVegetable as IFactoryInterface).Utilization;
(lAnotherVegetable as ISuperMarketInterface).Utilization;
Or otherwise using the supports routine
VAR lFactory:IFactoryInterface;
...
if supports(lSomeVegetable,IFactoryInterface,lFactory) then
lFactory.Utilization
...
Hopefully this will help you a little. Here's a pointer to some matching documentation

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

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'));

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.

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.