I have to translate some Fortran 90 code and found an interesting language feature.
As an example, they define the following type and dynamic-array variable:
TYPE WallInfo
CHARACTER(len=40) :: Name
REAL :: Azimuth
REAL :: Tilt
REAL :: Area
REAL :: Height
END TYPE WallInfo
TYPE(WallInfo), ALLOCATABLE, DIMENSION(:) :: Wall
Later in the code, they call a function:
CALL HeatFlow(Wall%Area, Wall%Azimuth)
As a Delphi programmer, this threw me a bit because Wall is an array of records!
From the usage in the routine, it is clear that Fortran can project fields from the record array as an array of their own.
SUBROUTINE HeatFlow( Area, Azimuth )
REAL, INTENT(IN), DIMENSION(:) :: Area
REAL, INTENT(IN), DIMENSION(:) :: Azimuth
Does anyone know if there is a way to do this with Delphi (I'm using version 2010)?
I could write a function to extract a record value as an array but this is a bit tedious because I will have to write a dedicated routine for every field (and there are a quite a few).
I'm hoping that there is some language feature in Delphi 2010 that I have missed.
Using Extended RTTI, it is possible to create a generic function that takes the array and a field name as input and uses the array's RTTI to extract just the values of that field and create a new array with them, with the correct data type.
The following code works for me in XE2:
uses
System.SysUtils, System.Rtti;
type
FieldArray<TArrElemType, TFieldType> = class
public
class function Extract(const Arr: TArray<TArrElemType>; const FieldName: String): TArray<TFieldType>;
end;
class function FieldArray<TArrElemType, TFieldType>.Extract(const Arr: TArray<TArrElemType>; const FieldName: String): TArray<TFieldType>;
var
Ctx: TRttiContext;
LArrElemType: TRttiType;
LField: TRttiField;
LFieldType: TRttiType;
I: Integer;
begin
Ctx := TRttiContext.Create;
try
LArrElemType := Ctx.GetType(TypeInfo(TArrElemType));
LField := LArrElemType.GetField(FieldName);
LFieldType := Ctx.GetType(TypeInfo(TFieldType));
if LField.FieldType <> LFieldType then
raise Exception.Create('Type mismatch');
SetLength(Result, Length(Arr));
for I := 0 to Length(Arr)-1 do
begin
Result[I] := LField.GetValue(@Arr[I]).AsType<TFieldType>;
end;
finally
Ctx.Free;
end;
end;
.
type
WallInfo = record
Name: array[0..39] of Char;
Azimuth: Real;
Tilt: Real;
Area: Real;
Height: Real;
end;
procedure HeatFlow(const Area: TArray<Real>; const Azimuth: TArray<Real>);
begin
// Area contains (4, 9) an Azimuth contains (2, 7) as expected ...
end;
var
Wall: TArray<WallInfo>;
begin
SetLength(Wall, 2);
Wall[0].Name := '1';
Wall[0].Azimuth := 2;
Wall[0].Tilt := 3;
Wall[0].Area := 4;
Wall[0].Height := 5;
Wall[1].Name := '6';
Wall[1].Azimuth := 7;
Wall[1].Tilt := 8;
Wall[1].Area := 9;
Wall[1].Height := 10;
HeatFlow(
FieldArray<WallInfo, Real>.Extract(Wall, 'Area'),
FieldArray<WallInfo, Real>.Extract(Wall, 'Azimuth')
);
end;
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With