The problem is shown in the example below
// Delphi ---------------------------------------
TMyClass = class
...
public
...
property Names: TArray<Variant> read GetNames write SetNames;
...
end;
TMyUtilsLibrary = class(TatScripterLibrary)
private
...
procedure _TMyClass_GetNames(M: TatVirtualMachine);
procedure _TMyClass_SetNames(M: TatVirtualMachine);
...
public
procedure Init; override;
end;
procedure TMyUtilsLibrary._TMyClass_GetNames(M: TatVirtualMachine);
begin
M.ReturnOutputArg(TMyClass(M.CurrentObject).Names);
end;
procedure TMyUtilsLibrary._TMyClass_SetNames(M: TatVirtualMachine);
var
Arg: Variant;
Names: TArray<Variant>;
I: Integer;
begin
Arg := M.GetInputArgAsVariant(0);
if not VarIsArray(Arg) then
begin
SetLength(Names, 1);
Names[0] := Arg;
end
else begin
SetLength(Names, VarArrayHighBound(Arg, 1) + 1);
for I := 0 to High(Names)
Names[I] := Arg[I];
end;
TMyClass(M.CurrentObject).Names := Names;
end;
procedure TMyUtilsLibrary.Init;
var
oClass: TatClass;
begin
...
oClass := Scripter.DefineClassByRTTI(TMyClass);
oClass.DefineProp('Names', TatTypeKind.tkDynArray, _TMyClass_GetNames, _TMyClass_SetNames);
...
end;
// Script ---------------------------------------
procedure Test;
var
C: TMyClass;
V: Variant;
begin
C := TMyClass.Create;
try
C.Names := ['A', 'B', 'C'];
// Compile error: Invalid array indexing for property 'Names'. Expected 0 dimensions. ...
// ShowMessage(C.Names[1]);
// Workaround
V := C.Names;
ShowMessage(V[1]); // ok, 'B'
finally
C.Free;
end;
end;
How should I define a property to fix this problem?
TIA and best regards
wlandgraf
(Wagner Landgraf)
2
Here it how you can implement it:
TMyUtilsLibrary = class(TatScripterLibrary)
private
procedure _TMyClass_GetNames(M: TatVirtualMachine);
procedure _TMyClass_SetNames(M: TatVirtualMachine);
procedure _TMyClass_GetNameValue(M: TatVirtualMachine);
procedure _TMyClass_SetNameValue(M: TatVirtualMachine);
public
procedure Init; override;
end;
...
procedure TMyUtilsLibrary._TMyClass_GetNames(M: TatVirtualMachine);
begin
M.ReturnOutputArg(TMyClass(M.CurrentObject).Names);
end;
procedure TMyUtilsLibrary._TMyClass_GetNameValue(M: TatVirtualMachine);
begin
M.ReturnOutputArg(TMyClass(M.CurrentObject).Names[M.GetArrayIndexAsInteger(0)]);
end;
procedure TMyUtilsLibrary._TMyClass_SetNames(M: TatVirtualMachine);
var
Arg: Variant;
Names: TArray<Variant>;
I: Integer;
begin
Arg := M.GetInputArgAsVariant(0);
if not VarIsArray(Arg) then
begin
SetLength(Names, 1);
Names[0] := Arg;
end
else begin
SetLength(Names, VarArrayHighBound(Arg, 1) + 1);
for I := 0 to High(Names) do
Names[I] := Arg[I];
end;
TMyClass(M.CurrentObject).Names := Names;
end;
procedure TMyUtilsLibrary._TMyClass_SetNameValue(M: TatVirtualMachine);
begin
TMyClass(M.CurrentObject).Names[M.GetArrayIndexAsInteger(0)] :=
M.GetInputArg(0);
end;
procedure TMyUtilsLibrary.Init;
var
oClass: TatClass;
begin
oClass := Scripter.DefineClassByRTTI(TMyClass);
oClass.DefineProp('Names', TatTypeKind.tkVariant, _TMyClass_GetNameValue,
_TMyClass_SetNameValue, nil, False, 1);
oClass.DefineMethod('GetNames', 0, TatTypeKind.tkVariant, nil, _TMyClass_GetNames);
oClass.DefineMethod('SetNames', 1, TatTypeKind.tkVariant, nil, _TMyClass_SetNames);
end;
Script:
// Script ---------------------------------------
procedure Test;
var
C: TMyClass;
V: Variant;
begin
C := TMyClass.Create;
try
C.SetNames(['A', 'B', 'C']);
// Compile error: Invalid array indexing for property 'Names'. Expected 0 dimensions. ...
ShowMessage(C.Names[1]);
C.Names[1] := 'Z';
// Workaround
V := C.GetNames;
ShowMessage(V[1]); // ok, 'B'
finally
C.Free;
end;
end;
Thanks, the solution to define Names as an indexed property is really smart!
Best regards
system
(system)
Closed
5
This topic was automatically closed 60 minutes after the last reply. New replies are no longer allowed.