ich habe Probleme mit PascalScript. Es wehrt sich bei den Interfaces.
mein Pascalscript ist:
Code: Alles auswählen
program classvererbungtest;
var
mycar : Volkswagen;
mywifescar : BMW;
mywifessecondcar : driveable;
begin
mycar := Volkswagen.create();
mycar.drive();
mywifescar := BMW.create();
mywifessecondcar := mywifescar.drive();
mywifessecondcar.drive();
end.
Code: Alles auswählen
program project1;
{$interfaces CORBA}
uses Interfaces ,
Classes,
uPSCompiler,
uPSR_std,
uPSC_std,
uPSR_classes,
uPSC_classes,
uPSRuntime,
uPSComponent,
SysUtils,
TypInfo,
pascalscript;
type
driveable = interface
function drive( ):driveable;
end;
car = class Abstract (TInterfacedObject,driveable)
public
function drive( ):driveable;virtual;Abstract;
end;
Volkswagen = class(car,driveable)
public
function drive( ):driveable;override;
end;
BMW = class(car,driveable)
public
function drive( ):driveable;override;
end;
mypascalscript = class
ps_script: TPSScript;
procedure OnExecImport(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter);
procedure OnCompile(Sender: TPSScript);
constructor Create(path:string);
end;
//mypascalscript
Constructor mypascalscript.Create(path:string);
begin
ps_script := TPSScript.create(nil);
ps_script.OnCompile:= @OnCompile;
ps_script.OnExecImport:= @OnExecImport;
ps_script.Script.LoadFromFile(path);
if ps_script.compile then
ps_script.execute
else //show any compile errors
begin
writeln('Pascal Script compile Error: ');
writeln(ps_script.CompilerErrorToStr(0));
end;
end;
procedure mypascalscript.OnExecImport(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter);
begin
RIRegister_Std(x);
RIRegister_Classes(x,true);
with x.Add(car) do
begin
RegisterVirtualAbstractMethod(car,@car.drive, 'drive');
end;
with x.Add(Volkswagen) do
begin
RegisterMethod(@volkswagen.drive, 'drive');
end;
with x.Add(BMW) do
begin
RegisterMethod(@BMW.drive, 'drive');
end;
end;
procedure mypascalscript.OnCompile(Sender: TPSScript);
begin
SIRegister_Std(Sender.Comp);
SIRegister_Classes(Sender.Comp,true);
with (Sender.Comp.AddInterface(Sender.Comp.FindInterface('IUNKNOWN'), GetTypeData(TypeInfo(driveable))^.GUID,'driveable')) do
begin
RegisterMethod('Function drive( ):driveable', cdRegister);
end;
with Sender.Comp.AddClassN(Sender.Comp.FindClass('TOBJECT'),'car') do
begin
// RegisterMethod('Function drive( ):driveable'); // is abstract --> may no decleration?
end;
with Sender.Comp.AddClassN(Sender.Comp.FindClass('car'),'Volkswagen') do
begin
RegisterMethod('Function drive( ):driveable');
end;
with Sender.Comp.AddClassN(Sender.Comp.FindClass('car'),'BMW') do
begin
RegisterMethod('Function drive( ):driveable');
end;
end;
// Volkswagen
function Volkswagen.drive( ):driveable;
begin
writeln('Classname: '+Self.ClassName);
writeln('Funktion: Volkswagen --> Drive');
exit(Self);
end;
// BMW
function BMW.drive( ):driveable;
begin
writeln('Classname: '+Self.ClassName);
writeln('Funktion: BMW --> Drive');
exit(Self);
end;
var
ps_script: mypascalscript;
mycar : Volkswagen;
mywifescar : BMW;
mywifessecondcar : driveable;
begin
writeln('');
writeln('Script:');
writeln('');
ps_script := mypascalscript.Create('yourscript.txt');
writeln('');
writeln('Compiled:');
writeln('');
mycar := Volkswagen.create();
mycar.drive();
mywifescar := BMW.create();
mywifessecondcar := mywifescar.drive();
mywifessecondcar.drive();
readln();
end.
Wie ersichtlich ist, ist im Script die Funktion BMW.drive nur einmal aufgerufen und im compilierten 2 mal.Script:
Classname: Volkswagen
Funktion: Volkswagen --> Drive
Classname: BMW
Funktion: BMW --> Drive
Compiled:
Classname: Volkswagen
Funktion: Volkswagen --> Drive
Classname: BMW
Funktion: BMW --> Drive
Classname: BMW
Funktion: BMW --> Drive
Warum verbindet er das Interface nicht mit BMW bei der Zuweisung?
Projekt zum Download: (3Kb)
https://owncloud.yourlahr.de/index.php/ ... 1QpdWgWDLr