Problem: resolving in script methods of delphi record like classes.
Example:
TMyRec=record
a,b:integer;
function Sum:integer;
end;
function TMyRec.Sum:integer;
begin
result:=a+b;
end;
Solution:
atScript.pas add method
procedure TatCustomScripter.GenericRecordMethodMachineProc(AMachine: TatVirtualMachine);
var
Context: TRttiContext;
rtype: TRttiType;
Methods: TArray<TRttiMethod>;
method: TRttiMethod;
args: array of TValue;
params: TArray<TRttiParameter>;
Result: TValue;
i, ArgCount: integer;
metClass: TClass;
metName: string;
begin
Context := TRttiContext.Create;
try
if AMachine.CurrentObject <> nil then
metClass := AMachine.CurrentObject.ClassType
else
metClass := AMachine.CurrentClass.ClassRef;
//rtype := Context.GetType(metClass);
if (AMachine.CurrentObject <> nil) and (AMachine.CurrentObject is TGenericRecordWrapper) then
begin
rtype := TGenericRecordWrapper(AMachine.CurrentObject).FRecordType;
end else rtype:=nil;
ArgCount := AMachine.InputArgCount;
// retrieve all methods with given name, so we can deal with overloads
metName := AMachine.CurrentMethodName;
if metName = '' then
metName := AMachine.CurrentPropertyName;
Methods := rtype.GetMethods(metName);
for method in Methods do
begin
params := method.GetParameters;
if ArgCount = Length(params) then
begin
// prepare method input parameters (array of TValue)
SetLength(args, ArgCount);
for i := 0 to ArgCount - 1 do
args := ScrPrepareValue(params.ParamType, AMachine.GetInputArg(i));
// invoke class or instance method
if method.IsClassMethod or method.IsConstructor then
Result := method.Invoke(metClass, args)
else
//Result := method.Invoke(AMachine.CurrentObject, args);
Result := method.Invoke(TGenericRecordWrapper(AMachine.CurrentObject).FRecordValue, args);
// return method result, if any
if (ScrTypeKind(method.ReturnType) <> tkNone) or method.IsConstructor then
AMachine.ReturnOutputArgValue(Result);
// set value of arguments passed by reference
for i := 0 to ArgCount - 1 do
if (pfVar in params.Flags) or (pfOut in params.Flags) then
AMachine.SetInputArgValue(i, args);
Break;
end;
end;
finally
Context.Free;
end;
end;
Replace original method in this redaction.
function TatCustomScripter.DefineRecordByRTTI(ATypeInfo: pointer): TatClass;
var
Context: TRttiContext;
atClass: TatClass;
rtype: TRttiType;
field: TRttiField;
//
Methods: TArray<TRttiMethod>;
method: TRttiMethod;
regClass: TClass;
regClassName: string;
TypeKind: TatTypeKind;
coverloaded: boolean;
Pars: TArray<TRttiParameter>;
scriptMethod: TatMethod;
c: integer;
begin
Context := TRttiContext.Create;
try
rtype := Context.GetType(ATypeInfo);
atClass := DefineRecord(ATypeInfo);
for field in rtype.GetFields do
atClass.DefineProp(field.Name, ScrTypeKind(field.FieldType),
GenericRecordFieldGetterMachineProc, GenericRecordFieldSetterMachineProc,
ScrClassType(field.FieldType)).FPropertyClassName := ScrClassName(field.FieldType);
Result := atClass;
// define methods
Methods := rtype.GetDeclaredMethods;
coverloaded := false;
for method in Methods do
begin
if method.HasExtendedInfo {and (method.Visibility in Options.VisibilityFilter)} then
begin
{if method.IsConstructor then
begin
regClass := AClass;
TypeKind := tkClass;
regClassName := '';
end
else}
begin
regClass := ScrClassType(method.ReturnType);
TypeKind := ScrTypeKind(method.ReturnType);
regClassName := ScrClassName(method.ReturnType);
end;
// define only first declared method when there are overloads
if {(Options.Redefine <> roInclude) or} (Result.MethodByName(method.Name) = nil) {or (method.IsConstructor and not coverloaded)}
then
begin
// Do not automatically override TScriptForm.Create method
//if not (AClass.InheritsFrom(FScripter.ScriptFormClass) and SameText(method.Name, 'Create')) then
begin
Pars := method.GetParameters;
scriptMethod := Result.DefineMethod(method.Name, Length(Pars), TypeKind, regClass,
GenericRecordMethodMachineProc, method.IsClassMethod or method.IsConstructor);
scriptMethod.FResultClassName := regClassName;
if method.IsConstructor then
coverloaded := True;
for c := 0 to Length(Pars) - 1 do
begin
// Set VarArgs
if (Pars[c].Flags * [pfVar, pfOut] <> []) then
scriptMethod.SetVarArgs([c]);
// if it's parameter, the copy the param name to method
if c < scriptMethod.ArgDefs.Count then
begin
scriptMethod.ArgDefs[c].FName := Pars[c].Name;
if Pars[c].ParamType <> nil then
scriptMethod.ArgDefs[c].FDataTypeName := Pars[c].ParamType.ToString
else
scriptMethod.ArgDefs[c].FDataTypeName := '';
end;
end;
end;
end;
{
if Options.Recursive then
begin
if regClass <> AClass then
RecursiveDefine(method.ReturnType);
for param in method.GetParameters do
RecursiveDefine(param.ParamType);
end;
}
end;
end;
finally
Context.Free;
end;
end;