Ich hoffe bei folgender Problemstellung kann mir jemand etwas Licht in's Dunkle bringen... Bei einem groesseren Projekt verfolge ich die hier in etwa zusammengefasste Struktur und treffe immer auf denselben Fehler:
Code: Alles auswählen
{
fpc -i
Free Pascal Compiler version 2.2.4
Compiler Date: 2009/10/18
Compiler CPU Target: i386
}
program Project1;
{$mode objfpc}
uses
Classes, SysUtils;
type
ITest1 = interface
['{5BC06B9E-A582-4AFD-BC5D-2C78DFBC13FE}']
procedure Test;
end;
ITest2 = interface
['{AB6094A7-F345-4E7F-B368-FDF7574B4115}']
procedure Test;
end;
TTest1 = class(TInterfacedObject, ITest1)
private
fCount1 : integer;
public
procedure Test;
property Count: integer read fCount1 default 0;
end;
TTest2 = class(TTest1, ITest2)
private
fCount2 : integer;
public
procedure Test;
property Count: integer read fCount2 default 0;
end;
procedure TTest1.Test;
begin
inc(fCount1);
end;
procedure TTest2.Test;
begin
inc(fCount2);
end;
procedure Convert(aClass: TObject; out aOut: TObject);
begin
aOut := nil;
// folgender IF Bedinung Kommentierung entfernen und es haengt
// if Supports(aClass, ITest2) then
aOut := aClass;
end;
var count: integer;
fTestClass1: TTest1;
fTestClass2: TTest2;
fTestObject: TObject;
fTestIntf: ITest2;
begin
fTestClass2 := TTest2.Create;
fTestClass1 := fTestClass2;
Convert(fTestClass1, fTestObject);
{$ASSERTIONS ON}
Assert(assigned(fTestObject), 'not assigned');
{$ASSERTIONS OFF}
fTestIntf := fTestObject as ITest2;
fTestIntf.Test;
if Supports(fTestObject, ITest1) then begin
(fTestObject as ITest1).Test;
writeln(fTestClass2.Count);
end;
if Supports(fTestObject, ITest2) then begin
(fTestObject as ITest2).Test;
writeln(fTestClass2.Count);
end;
end.
So das ganze kann dann im Haertefall obiger Zusammenfassung aussehen, gehe ich jedoch mit der Supports Methode ran, dann knallt es. Versuche ueber den IS Operator sind ebenfalls gescheiter. Nun halt die beliebte Frage an Euch, wo ist der Fehler?!?
Gruss
// Benno