Question

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.

Answer 1

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;