Testing TValue as Params

This commit is contained in:
Michael Schimmel
2025-07-28 00:55:39 +02:00
parent 1ddc295c9d
commit 75675b8dc1
4 changed files with 107 additions and 145 deletions
+3 -25
View File
@@ -293,6 +293,7 @@ end;
procedure TForm1.Button1Click(Sender: TObject); procedure TForm1.Button1Click(Sender: TObject);
begin begin
Test1(LogMemo.Lines); Test1(LogMemo.Lines);
end; end;
function TForm1.CreateStrategy2(Timeframe: TTimeframe): IConsumer<TDataPoint<TOhlcItem>>; function TForm1.CreateStrategy2(Timeframe: TTimeframe): IConsumer<TDataPoint<TOhlcItem>>;
@@ -321,19 +322,7 @@ begin
var Lowest: Double := Double.MaxValue; var Lowest: Double := Double.MaxValue;
var Highest: Double := Double.MinValue; var Highest: Double := Double.MinValue;
var ATR := var ATR := Ohlc.Chain<Double>(TATR.CreateATR(50)).MakeParallel;
Ohlc
.Chain<TATR.TArgs>(
TConverter<TOhlcItem, TATR.TArgs>.CreateConverter(
function(const Ohlc: TOhlcItem): TATR.TArgs
begin
Result.Close := Ohlc.Close;
Result.High := Ohlc.High;
Result.Low := Ohlc.Low;
end
))
.Chain<Double>(TATR.CreateATR(50))
.MakeParallel;
// next stage // next stage
@@ -638,18 +627,7 @@ begin
var Rsi := Closes.Chain<Double>(TRSI.CreateRSI(14)); var Rsi := Closes.Chain<Double>(TRSI.CreateRSI(14));
var Macd := Closes.MakeParallel.Chain<TMacd.TResult>(TMACD.CreateMACD(12, 26, 9)); var Macd := Closes.MakeParallel.Chain<TMacd.TResult>(TMACD.CreateMACD(12, 26, 9));
var Stoch := var Stoch := Ohlc.Chain<TStochastic.TResult>(TStochastic.CreateStochastic(14, 3));
Ohlc
.Chain<TStochastic.TArgs>(
TConverter<TOhlcItem, TStochastic.TArgs>.CreateConverter(
function(const Ohlc: TOhlcItem): TStochastic.TArgs
begin
Result.Close := Ohlc.Close;
Result.High := Ohlc.High;
Result.Low := Ohlc.Low;
end
))
.Chain<TStochastic.TResult>(TStochastic.CreateStochastic(14, 3));
chart.SetXAxisSeries(timeframe, Timestamps); chart.SetXAxisSeries(timeframe, Timestamps);
+1 -12
View File
@@ -38,18 +38,7 @@ begin
var Hull := Closes.Chain<Double>(THMA.CreateHMA(250)).MakeParallel; var Hull := Closes.Chain<Double>(THMA.CreateHMA(250)).MakeParallel;
var Sma := Closes.Chain<Double>(TSMA.CreateSMA(200)).MakeParallel; var Sma := Closes.Chain<Double>(TSMA.CreateSMA(200)).MakeParallel;
var ATR := var ATR := Ohlc.Chain<Double>(TATR.CreateATR(50));
Ohlc
.Chain<TATR.TArgs>(
TConverter<TOhlcItem, TATR.TArgs>.CreateConverter(
function(const Ohlc: TOhlcItem): TATR.TArgs
begin
Result.Close := Ohlc.Close;
Result.High := Ohlc.High;
Result.Low := Ohlc.Low;
end
))
.Chain<Double>(TATR.CreateATR(50));
var conv := TConverter.Join<Double>([Ohlc.Field<Double>('Low'), Ohlc.Field<Double>('High'), Closes, ATR, Hull, Sma]); var conv := TConverter.Join<Double>([Ohlc.Field<Double>('Low'), Ohlc.Field<Double>('High'), Closes, ATR, Hull, Sma]);
+37 -43
View File
@@ -6,6 +6,7 @@ uses
System.SysUtils, System.SysUtils,
System.Math, System.Math,
System.Rtti, System.Rtti,
Myc.Data.Records,
Myc.Data.Pipeline, Myc.Data.Pipeline,
Myc.Data.Series, Myc.Data.Series,
Myc.Trade.Types, Myc.Trade.Types,
@@ -147,9 +148,7 @@ type
DPeriod: Integer; DPeriod: Integer;
end; end;
TArgs = record TArgs = record
High: Double; Value: TOhlcItem;
Low: Double;
Close: Double;
end; end;
TResult = record TResult = record
K: Double; // %K line K: Double; // %K line
@@ -157,12 +156,12 @@ type
end; end;
[IndicatorFactory] [IndicatorFactory]
class function CreateFactory: TIndicatorFactoryProc<TParams, TArgs, TResult>; static; class function CreateFactory: TIndicatorFactoryProc<TParams, TArgs, TResult>; static;
class function CreateStochastic(KPeriod, DPeriod: Integer): TConvertFunc<TOhlcItem, TResult>; overload; static;
class function CreateStochastic(KPeriod, DPeriod: Integer): TConvertFunc<TArgs, TResult>; overload; static; // Creates a Stochastic Oscillator using an injectable moving average for the %D line.
class function CreateStochastic( class function CreateStochastic(
KPeriod: Integer; KPeriod: Integer;
const SmaD: TConvertFunc<Double, Double> const SmaD: TConvertFunc<Double, Double>
): TConvertFunc<TArgs, TStochastic.TResult>; overload; static; ): TConvertFunc<TOhlcItem, TStochastic.TResult>; overload; static;
end; end;
[IndicatorName('StdDev', 'Standard Deviation')] [IndicatorName('StdDev', 'Standard Deviation')]
@@ -215,17 +214,15 @@ type
Period: Integer; Period: Integer;
end; end;
TArgs = record TArgs = record
High: Double; Value: TOhlcItem;
Low: Double;
Close: Double;
end; end;
TResult = record TResult = record
ATR: Double; ATR: Double;
end; end;
[IndicatorFactory] [IndicatorFactory]
class function CreateFactory: TIndicatorFactoryProc<TParams, TArgs, TResult>; static; class function CreateFactory: TIndicatorFactoryProc<TParams, TArgs, TResult>; static;
class function CreateATR(Period: Integer): TConvertFunc<TArgs, Double>; overload; static; class function CreateATR(Period: Integer): TConvertFunc<TOhlcItem, Double>; overload; static;
class function CreateATR(const MovAvgTR: TConvertFunc<Double, Double>): TConvertFunc<TArgs, Double>; overload; static; class function CreateATR(const MovAvgTR: TConvertFunc<Double, Double>): TConvertFunc<TOhlcItem, Double>; overload; static;
end; end;
[IndicatorName('KC', 'Keltner Channels')] [IndicatorName('KC', 'Keltner Channels')]
@@ -238,9 +235,7 @@ type
Multiplier: Double; Multiplier: Double;
end; end;
TArgs = record TArgs = record
High: Double; Value: TOhlcItem;
Low: Double;
Close: Double;
end; end;
TResult = record TResult = record
UpperBand: Double; UpperBand: Double;
@@ -249,12 +244,12 @@ type
end; end;
[IndicatorFactory] [IndicatorFactory]
class function CreateFactory: TIndicatorFactoryProc<TParams, TArgs, TResult>; static; class function CreateFactory: TIndicatorFactoryProc<TParams, TArgs, TResult>; static;
class function CreateKeltnerChannels(Period: Integer; Multiplier: Double): TConvertFunc<TArgs, TResult>; overload; static; class function CreateKeltnerChannels(Period: Integer; Multiplier: Double): TConvertFunc<TOhlcItem, TResult>; overload; static;
class function CreateKeltnerChannels( class function CreateKeltnerChannels(
const MovAvgMiddle: TConvertFunc<Double, Double>; const MovAvgMiddle: TConvertFunc<Double, Double>;
const AtrFunc: TConvertFunc<TATR.TArgs, Double>; const AtrFunc: TConvertFunc<TOhlcItem, Double>;
Multiplier: Double Multiplier: Double
): TConvertFunc<TArgs, TKeltnerChannels.TResult>; overload; static; ): TConvertFunc<TOhlcItem, TKeltnerChannels.TResult>; overload; static;
end; end;
[IndicatorName('Mean', 'Mean Value')] [IndicatorName('Mean', 'Mean Value')]
@@ -713,22 +708,25 @@ begin
Result := Result :=
function(const Params: TParams): TConvertFunc<TArgs, TResult> function(const Params: TParams): TConvertFunc<TArgs, TResult>
var var
stochFunc: TConvertFunc<TArgs, TResult>; stochFunc: TConvertFunc<TOhlcItem, TResult>;
begin begin
stochFunc := CreateStochastic(Params.KPeriod, Params.DPeriod); stochFunc := CreateStochastic(Params.KPeriod, Params.DPeriod);
Result := function(const Value: TArgs): TResult begin Result := stochFunc(Value); end; Result := function(const Value: TArgs): TResult begin Result := stochFunc(Value.Value); end;
end; end;
end; end;
class function TStochastic.CreateStochastic(KPeriod, DPeriod: Integer): TConvertFunc<TArgs, TResult>; class function TStochastic.CreateStochastic(KPeriod, DPeriod: Integer): TConvertFunc<TOhlcItem, TStochastic.TResult>;
begin begin
Result := CreateStochastic(KPeriod, TSMA.CreateSMA(DPeriod)); Result := CreateStochastic(KPeriod, TSMA.CreateSMA(DPeriod));
end; end;
// Creates a Stochastic Oscillator using an injectable moving average for the %D line. // Creates a Stochastic Oscillator using an injectable moving average for the %D line.
class function TStochastic.CreateStochastic(KPeriod: Integer; const SmaD: TConvertFunc<Double, Double>): TConvertFunc<TArgs, TResult>; class function TStochastic.CreateStochastic(
KPeriod: Integer;
const SmaD: TConvertFunc<Double, Double>
): TConvertFunc<TOhlcItem, TStochastic.TResult>;
var var
buffer: TArray<TArgs>; buffer: TArray<TOhlcItem>;
highDeque: TLightDeque; highDeque: TLightDeque;
lowDeque: TLightDeque; lowDeque: TLightDeque;
valueCount: Int64; valueCount: Int64;
@@ -736,7 +734,7 @@ begin
if (KPeriod <= 0) then if (KPeriod <= 0) then
begin begin
Result := Result :=
function(const Value: TArgs): TResult function(const Value: TOhlcItem): TResult
begin begin
Result.K := Double.NaN; Result.K := Double.NaN;
Result.D := Double.NaN; Result.D := Double.NaN;
@@ -750,7 +748,7 @@ begin
valueCount := 0; valueCount := 0;
Result := Result :=
function(const Value: TArgs): TStochastic.TResult function(const Value: TOhlcItem): TStochastic.TResult
var var
currentIndex, firstIndex, lastIndex: Integer; currentIndex, firstIndex, lastIndex: Integer;
highestHigh, lowestLow: Double; highestHigh, lowestLow: Double;
@@ -928,25 +926,25 @@ begin
Result := Result :=
function(const Params: TParams): TConvertFunc<TArgs, TResult> function(const Params: TParams): TConvertFunc<TArgs, TResult>
var var
atrFunc: TConvertFunc<TArgs, Double>; atrFunc: TConvertFunc<TOhlcItem, Double>;
begin begin
atrFunc := CreateATR(Params.Period); atrFunc := CreateATR(Params.Period);
Result := function(const Value: TArgs): TResult begin Result.ATR := atrFunc(Value); end; Result := function(const Value: TArgs): TResult begin Result.ATR := atrFunc(Value.Value); end;
end; end;
end; end;
class function TATR.CreateATR(Period: Integer): TConvertFunc<TArgs, Double>; class function TATR.CreateATR(Period: Integer): TConvertFunc<TOhlcItem, Double>;
begin begin
Result := CreateATR(TEMA.CreateEMA(Period)); Result := CreateATR(TEMA.CreateEMA(Period));
end; end;
// Calculates the Average True Range (ATR) using an injectable moving average. // Calculates the Average True Range (ATR) using an injectable moving average.
class function TATR.CreateATR(const MovAvgTR: TConvertFunc<Double, Double>): TConvertFunc<TArgs, Double>; class function TATR.CreateATR(const MovAvgTR: TConvertFunc<Double, Double>): TConvertFunc<TOhlcItem, Double>;
begin begin
var sourceData: TSeries<TArgs>; var sourceData: TSeries<TOhlcItem>;
Result := Result :=
function(const Value: TArgs): Double function(const Value: TOhlcItem): Double
var var
tr: Double; tr: Double;
begin begin
@@ -970,19 +968,20 @@ end;
{ TKeltnerChannels } { TKeltnerChannels }
class function TKeltnerChannels.CreateFactory: TIndicatorFactoryProc<TParams, TArgs, TResult>; class function TKeltnerChannels.CreateFactory:
TIndicatorFactoryProc<TKeltnerChannels.TParams, TKeltnerChannels.TArgs, TKeltnerChannels.TResult>;
begin begin
Result := Result :=
function(const Params: TParams): TConvertFunc<TArgs, TResult> function(const Params: TParams): TConvertFunc<TArgs, TResult>
var var
kcFunc: TConvertFunc<TArgs, TResult>; kcFunc: TConvertFunc<TOhlcItem, TResult>;
begin begin
kcFunc := CreateKeltnerChannels(Params.Period, Params.Multiplier); kcFunc := CreateKeltnerChannels(Params.Period, Params.Multiplier);
Result := function(const Value: TArgs): TResult begin Result := kcFunc(Value); end; Result := function(const Value: TArgs): TResult begin Result := kcFunc(Value.Value); end;
end; end;
end; end;
class function TKeltnerChannels.CreateKeltnerChannels(Period: Integer; Multiplier: Double): TConvertFunc<TArgs, TResult>; class function TKeltnerChannels.CreateKeltnerChannels(Period: Integer; Multiplier: Double): TConvertFunc<TOhlcItem, TResult>;
begin begin
Result := CreateKeltnerChannels(TEMA.CreateEMA(Period), TATR.CreateATR(Period), Multiplier); Result := CreateKeltnerChannels(TEMA.CreateEMA(Period), TATR.CreateATR(Period), Multiplier);
end; end;
@@ -990,12 +989,12 @@ end;
// Calculates Keltner Channels using an injectable ATR and middle band moving average. // Calculates Keltner Channels using an injectable ATR and middle band moving average.
class function TKeltnerChannels.CreateKeltnerChannels( class function TKeltnerChannels.CreateKeltnerChannels(
const MovAvgMiddle: TConvertFunc<Double, Double>; const MovAvgMiddle: TConvertFunc<Double, Double>;
const AtrFunc: TConvertFunc<TATR.TArgs, Double>; const AtrFunc: TConvertFunc<TOhlcItem, Double>;
Multiplier: Double Multiplier: Double
): TConvertFunc<TArgs, TKeltnerChannels.TResult>; ): TConvertFunc<TOhlcItem, TKeltnerChannels.TResult>;
begin begin
Result := Result :=
function(const Value: TArgs): TKeltnerChannels.TResult function(const Value: TOhlcItem): TKeltnerChannels.TResult
var var
atrValue, middleValue, typicalPrice: Double; atrValue, middleValue, typicalPrice: Double;
begin begin
@@ -1004,12 +1003,7 @@ begin
// Get values from the provided indicator functions. // Get values from the provided indicator functions.
middleValue := MovAvgMiddle(typicalPrice); middleValue := MovAvgMiddle(typicalPrice);
atrValue := AtrFunc(Value);
var atrArgs: TATR.TArgs;
atrArgs.High := Value.High;
atrArgs.Low := Value.Low;
atrArgs.Close := Value.Close;
atrValue := AtrFunc(atrArgs);
// Set default NaN values for the warm-up period. // Set default NaN values for the warm-up period.
Result.MiddleBand := middleValue; Result.MiddleBand := middleValue;
+66 -65
View File
@@ -5,12 +5,13 @@ interface
{$M+} {$M+}
uses uses
System.TypInfo,
System.Rtti, System.Rtti,
Myc.Data.Pipeline, Myc.Data.Pipeline,
System.Classes; System.Classes;
type type
TIndicatorFactoryProc<TParams, TValue, TResult> = reference to function(const Params: TParams): TConvertFunc<TValue, TResult>; TIndicatorFactoryProc<TParams, TArgs, TResult> = reference to function(const Params: TParams): TConvertFunc<TArgs, TResult>;
(* (*
Sample definition of an indicator template: Sample definition of an indicator template:
@@ -65,23 +66,24 @@ type
TFieldDef = record TFieldDef = record
public public
Identifier: String; Identifier: String;
TypeName: String; // The handle provides direct access to the type information of the field.
Handle: PTypeInfo;
end; end;
TFieldLayout = TArray<TFieldDef>; TFieldLayout = TArray<TFieldDef>;
// Interface for creating an indicator instance. Only contains functional aspects. // Interface for creating an indicator instance. Only contains functional aspects.
IIndicatorFactory = interface IIndicatorFactory = interface
function GetParams: TFieldLayout; function GetParamType: PTypeInfo;
function GetArgs: TFieldLayout; function GetArgType: PTypeInfo;
function GetResults: TFieldLayout; function GetResultType: PTypeInfo;
function CreateIndicator(const Params: TValue): TConvertFunc<TValue, TValue>; function CreateIndicator(const Params: TValue): TConvertFunc<TValue, TValue>;
// Provides the layout for the indicator's parameters, arguments, and results. // Provides direct access to the type information of parameters, arguments, and results.
property Params: TFieldLayout read GetParams; property ParamType: PTypeInfo read GetParamType;
property Args: TFieldLayout read GetArgs; property ArgType: PTypeInfo read GetArgType;
property Results: TFieldLayout read GetResults; property ResultType: PTypeInfo read GetResultType;
end; end;
TGenericIndicatorFactory = class(TInterfacedObject, IIndicatorFactory) TGenericIndicatorFactory = class(TInterfacedObject, IIndicatorFactory)
@@ -90,23 +92,21 @@ type
FName: String; FName: String;
FShortName: String; FShortName: String;
FHint: String; FHint: String;
FParams: TFieldLayout; FParamType: PTypeInfo;
FArgs: TFieldLayout; FArgType: PTypeInfo;
FResults: TFieldLayout; FResultType: PTypeInfo;
class function LayoutFromRecordType(RecordType: TRttiType): TFieldLayout; static;
public public
constructor Create( constructor Create(
const AFactoryProc: TIndicatorFactoryProc<TValue, TValue, TValue>; const AFactoryProc: TIndicatorFactoryProc<TValue, TValue, TValue>;
const AShortName, AName, AHint: String; const AShortName, AName, AHint: String;
const AParams, AArgs, AResults: TFieldLayout const AParamType, AArgType, AResultType: PTypeInfo
); );
// IIndicatorFactory // IIndicatorFactory
function GetParams: TFieldLayout; function GetParamType: PTypeInfo;
function GetArgs: TFieldLayout; function GetArgType: PTypeInfo;
function GetResults: TFieldLayout; function GetResultType: PTypeInfo;
function CreateIndicator(const Params: TValue): TConvertFunc<TValue, TValue>; overload; function CreateIndicator(const Params: TValue): TConvertFunc<TValue, TValue>; overload;
class function CreateFromTemplate<T>: TGenericIndicatorFactory; class function CreateFromTemplate<T>: TGenericIndicatorFactory;
@@ -165,8 +165,7 @@ var
implementation implementation
uses uses
System.SysUtils, System.SysUtils;
System.TypInfo;
constructor IndicatorNameAttribute.Create(const AShortName, AName: string); constructor IndicatorNameAttribute.Create(const AShortName, AName: string);
begin begin
@@ -186,7 +185,7 @@ end;
constructor TGenericIndicatorFactory.Create( constructor TGenericIndicatorFactory.Create(
const AFactoryProc: TIndicatorFactoryProc<TValue, TValue, TValue>; const AFactoryProc: TIndicatorFactoryProc<TValue, TValue, TValue>;
const AShortName, AName, AHint: String; const AShortName, AName, AHint: String;
const AParams, AArgs, AResults: TFieldLayout const AParamType, AArgType, AResultType: PTypeInfo
); );
begin begin
inherited Create; inherited Create;
@@ -194,30 +193,9 @@ begin
FShortName := AShortName; FShortName := AShortName;
FName := AName; FName := AName;
FHint := AHint; FHint := AHint;
FParams := AParams; FParamType := AParamType;
FArgs := AArgs; FArgType := AArgType;
FResults := AResults; FResultType := AResultType;
end;
class function TGenericIndicatorFactory.LayoutFromRecordType(RecordType: TRttiType): TFieldLayout;
var
rttiRecordType: TRttiRecordType;
field: TRttiField;
i: Integer;
begin
if not RecordType.IsRecord then
raise EArgumentException.CreateFmt('Record type expected, but got %s', [RecordType.Name]);
rttiRecordType := RecordType as TRttiRecordType;
var fields := rttiRecordType.GetFields;
SetLength(Result, Length(fields));
i := 0;
for field in fields do
begin
Result[i].Identifier := field.Name;
Result[i].TypeName := field.FieldType.Name;
Inc(i);
end;
end; end;
class function TGenericIndicatorFactory.CreateFromTemplate<T>: TGenericIndicatorFactory; class function TGenericIndicatorFactory.CreateFromTemplate<T>: TGenericIndicatorFactory;
@@ -228,7 +206,6 @@ var
templateFactoryMethod: TRttiMethod; templateFactoryMethod: TRttiMethod;
factoryProc: TIndicatorFactoryProc<TValue, TValue, TValue>; factoryProc: TIndicatorFactoryProc<TValue, TValue, TValue>;
shortName, name, hint: string; shortName, name, hint: string;
paramsLayout, argsLayout, resultsLayout: TFieldLayout;
begin begin
// This function creates a generic factory from a template class. // This function creates a generic factory from a template class.
// It uses RTTI to find the necessary types by inspecting the factory method signature, // It uses RTTI to find the necessary types by inspecting the factory method signature,
@@ -300,11 +277,6 @@ begin
Assert(argsType.TypeKind = tkRecord); Assert(argsType.TypeKind = tkRecord);
Assert(resultType.TypeKind = tkRecord); Assert(resultType.TypeKind = tkRecord);
// Generate layouts from RTTI types.
paramsLayout := LayoutFromRecordType(paramsType);
argsLayout := LayoutFromRecordType(argsType);
resultsLayout := LayoutFromRecordType(resultType);
// Extract metadata from attributes on the template type T. // Extract metadata from attributes on the template type T.
shortName := ''; shortName := '';
name := ''; name := '';
@@ -349,8 +321,6 @@ begin
// The parameter for this 'Invoke' call is the TParams record. // The parameter for this 'Invoke' call is the TParams record.
// Wrap the incoming TValue 'Params' into a TValue for the call. // Wrap the incoming TValue 'Params' into a TValue for the call.
var factoryParamTypeInfo := currentFactoryInvoke.GetParameters[0].ParamType.Handle;
Assert(factoryParamTypeInfo = paramsType.Handle);
// This call returns the worker proc (e.g., a TIndicatorProc<TValue, TResult>) as a TValue. // This call returns the worker proc (e.g., a TIndicatorProc<TValue, TResult>) as a TValue.
var workerProc := currentFactoryInvoke.Invoke(factoryProc, [Params]); var workerProc := currentFactoryInvoke.Invoke(factoryProc, [Params]);
@@ -369,23 +339,23 @@ begin
end; end;
end; end;
// Create the final factory instance with all layouts and extracted metadata. // Create the final factory instance with all type handles and extracted metadata.
Result := TGenericIndicatorFactory.Create(factoryProc, shortName, name, hint, paramsLayout, argsLayout, resultsLayout); Result := TGenericIndicatorFactory.Create(factoryProc, shortName, name, hint, paramsType.Handle, argsType.Handle, resultType.Handle);
end; end;
function TGenericIndicatorFactory.GetParams: TFieldLayout; function TGenericIndicatorFactory.GetParamType: PTypeInfo;
begin begin
Result := FParams; Result := FParamType;
end; end;
function TGenericIndicatorFactory.GetArgs: TFieldLayout; function TGenericIndicatorFactory.GetArgType: PTypeInfo;
begin begin
Result := FArgs; Result := FArgType;
end; end;
function TGenericIndicatorFactory.GetResults: TFieldLayout; function TGenericIndicatorFactory.GetResultType: PTypeInfo;
begin begin
Result := FResults; Result := FResultType;
end; end;
function TGenericIndicatorFactory.CreateIndicator(const Params: TValue): TConvertFunc<TValue, TValue>; function TGenericIndicatorFactory.CreateIndicator(const Params: TValue): TConvertFunc<TValue, TValue>;
@@ -451,6 +421,36 @@ procedure TIndicatorRegistry.LogRegistry(const Log: TStrings);
var var
item: TItem; item: TItem;
// Generates a field layout from a type information handle.
function LayoutFromTypeInfo(TypeInfo: PTypeInfo): TFieldLayout;
var
Ctx: TRttiContext;
rttiType: TRttiType;
rttiRecordType: TRttiRecordType;
field: TRttiField;
i: Integer;
begin
// This helper uses RTTI to inspect the record type and build the layout.
Ctx := TRttiContext.Create;
rttiType := Ctx.GetType(TypeInfo);
if not rttiType.IsRecord then
begin
SetLength(Result, 0);
exit;
end;
rttiRecordType := rttiType as TRttiRecordType;
var fields := rttiRecordType.GetFields;
SetLength(Result, Length(fields));
i := 0;
for field in fields do
begin
Result[i].Identifier := field.Name;
Result[i].Handle := field.FieldType.Handle;
Inc(i);
end;
end;
procedure DoLog(const Txt: String); procedure DoLog(const Txt: String);
begin begin
Log.Add(Txt); Log.Add(Txt);
@@ -468,7 +468,7 @@ var
else else
begin begin
for field in Layout do for field in Layout do
DoLog(Format(' - %s: %s', [field.Identifier, field.TypeName])); DoLog(Format(' - %s: %s', [field.Identifier, field.Handle.Name]));
end; end;
end; end;
@@ -493,9 +493,10 @@ begin
if not item.Hint.IsEmpty then if not item.Hint.IsEmpty then
DoLog(Format(' Hint: %s', [item.Hint])); DoLog(Format(' Hint: %s', [item.Hint]));
LogLayout('Params', item.Factory.Params); // Generate layouts on-the-fly from the factory's type info.
LogLayout('Args', item.Factory.Args); LogLayout('Params', LayoutFromTypeInfo(item.Factory.ParamType));
LogLayout('Result', item.Factory.Results); LogLayout('Args', LayoutFromTypeInfo(item.Factory.ArgType));
LogLayout('Result', LayoutFromTypeInfo(item.Factory.ResultType));
DoLog(''); DoLog('');
end; end;
end; end;