unit orm_utils;

{$TYPEINFO ON}

interface

uses
  System.Classes, System.Generics.Collections, System.Rtti, Uni,
  TypInfo, SysUtils, StrUtils, DateUtils, Math, pixel_classes, pixel_utils,
  System.Variants, ORM_CustomAttributes;

type
  TQryRecInfo = class
  private
    FDirtyFields: TDictionary<string, Boolean>;
    FPreviousValues: TDictionary<string, TValue>;
    procedure Set_Info(Index: integer; const Value: TValue);
  public
    constructor Create;
    destructor Destroy; override;

    procedure Set_Info_NullableString(Index: integer; const Value: TNullable<string>);
    procedure Set_Info_NullableInteger(Index: integer; const Value: TNullable<Integer>);
    procedure Set_Info_NullableInt64(Index: integer; const Value: TNullable<Int64>);
    procedure Set_Info_NullableExtended(Index: integer; const Value: TNullable<Extended>);
    procedure Set_Info_NullableCurrency(Index: integer; const Value: TNullable<Currency>);
    procedure Set_Info_NullableDateTime(Index: integer; const Value: TNullable<TDateTime>);
    procedure Set_Info_NullableBoolean(Index: integer; const Value: TNullable<Boolean>);
    procedure Set_Info_NullableVariant(Index: integer; const Value: TNullable<Variant>);

    // Methods to handle dirty fields
    function IsFieldDirty(const FieldName: string): Boolean;
    procedure ClearDirtyFlags;
    property DirtyFields: TDictionary<string, Boolean> read FDirtyFields;

    // Methods to handle previous values
    function GetPreviousValue(const FieldName: string): TValue;
    procedure ClearPreviousValues;
    property PreviousValues: TDictionary<string, TValue> read FPreviousValues;

    /// <summary>
    /// Retrieves the formatted text for a given field based on the FmtProp attribute.
    /// </summary>
    function GetFormattedText(const FieldName: string): string;
    procedure Fetch(DBConn: TUniConnection; QryTxt: string);
  end;

function FormataInfo(info: Variant; tipo: TFormatType): string;

type
 TDynRec = class(TQryRecInfo)
  private
   // procedure SetCampoValue(const NomeCampo: string; const Value: Variant);
   // function GetCampoValue(const NomeCampo: string): Variant;
  public
   // property Value[const NomeCampo: string]: Variant read GetCampoValue write SetCampoValue; default;
 end;

implementation

function FormataInfo(info: Variant; tipo: TFormatType): string;
begin
  // info := System.Variants.Null;
  if VarIsNull(info) or VarIsEmpty(info) then
    Exit(EmptyStr);

  if VarType(info) = varUString then
  begin
    case tipo of
      tiInteger: Exit(PegaInt(info).ToString);
      tiMoney: Exit(FormatFloat(FMT_MONEY, GetMoney(info)));
      tiFloat: Exit(FloatToStr(PegaFloat(info)));
      tiDate: Exit(FormatDateTime('dd/mm/yyyy', PegaData(info)));
      tiDateTime: Exit(FormatDateTime('dd/mm/yyyy hh:mm:ss', PegaDataHora(info)));
      tiBoolean: Exit(IIF(info, 'S', 'N'));
      tiByteArray: Exit(ByteArrayToHex(info));
      tiNone: Exit(EmptyStr);
    end;
  end;

  case tipo of
    tiString: Result := VarToStr(info);
    tiInteger: Result := IntToStr(Integer(info));
    tiMoney: Result := FormatFloat(FMT_MONEY, Currency(info));
    tiFloat: Result := FloatToStr(info);
    tiBoolean: Result := string(IIF(Boolean(info), 'S', 'N'));
    tiByteArray: Result := string(ByteArrayToHex(info));
    tiDate:
      begin
        if VarType(info) in [varDate, varDouble] then
        begin
          if info = 0 then Exit(EmptyStr)
          else if VarToDateTime(info) < EncodeDate(1900, 1, 1) then Exit(EmptyStr)
          else Exit(FormatDateTime('dd/mm/yyyy', VarToDateTime(info)));
        end
        else
          raise Exception.Create('FormataInfo: A informação [' + VarToStr(info) + '] não pode ser tratada como tiDate');
      end;
    tiDateTime:
      begin
        if VarType(info) in [varDate, varDouble] then
        begin
          if info = 0 then Exit(EmptyStr)
          else Exit(FormatDateTime('dd/mm/yyyy hh:mm:ss', VarToDateTime(info)));
        end
        else
          raise Exception.Create('FormataInfo: A informação [' + VarToStr(info) + '] não pode ser tratada como tiDateTime');
      end;
    tiNone: Result := EmptyStr;
    else
      raise Exception.Create('FormataInfo: o [' + GetEnumName(TypeInfo(TFormatType), Integer(tipo)) + '] não foi encontrado');
  end;
end;

{ TQryRecInfo }

function TQryRecInfo.GetFormattedText(const FieldName: string): string;
var
  Ctx: TRttiContext;
  RttiType: TRttiType;
  Prop: TRttiProperty;
  Field: TRttiField;
  Value: TValue;
  FmtType: TFormatType;
  UnderlyingType: TRttiType;
  HasValueField: TRttiField;
  ValueField: TRttiField;
  HasValue: Boolean;
  ActualValue: TValue;
  Attr: TCustomAttribute;
  FmtAttr: FmtPropAttribute;
  PropKind: TTypeKind;
  Index: Integer;
  PropName: string;
begin
  Result := EmptyStr;
  Ctx := TRttiContext.Create;
  try
    RttiType := Ctx.GetType(Self.ClassType);

    // Find the property by name
    Prop := RttiType.GetProperty(FieldName);
    if not Assigned(Prop) then
      raise Exception.CreateFmt('Property "%s" not found.', [FieldName]);

    // Get the value of the property
    Value := Prop.GetValue(Self);
    FmtType := tiNone;

    // Check for FmtProp attribute on the property
    for Attr in Prop.GetAttributes do
    begin
      if Attr is FmtPropAttribute then
      begin
        FmtAttr := FmtPropAttribute(Attr);
        FmtType := FmtAttr.FormatType;
        Break;
      end;
    end;

    // If not found on property, check on the corresponding field
    if FmtType = tiNone then
    begin
      Field := RttiType.GetField('_' + FieldName);
      if Assigned(Field) then
      begin
        for Attr in Field.GetAttributes do
        begin
          if Attr is FmtPropAttribute then
          begin
            FmtAttr := FmtPropAttribute(Attr);
            FmtType := FmtAttr.FormatType;
            Break;
          end;
        end;
      end;
    end;

    // If still not found, determine default FmtType based on property type
    if FmtType = tiNone then
    begin
      UnderlyingType := Prop.PropertyType;

      // If the property is a TNullable<T>
      if UnderlyingType.TypeKind = tkRecord then
      begin
        // Attempt to get the 'Value' field of TNullable<T>
        ValueField := UnderlyingType.GetField('Value');
        if Assigned(ValueField) then
        begin
          UnderlyingType := ValueField.FieldType;
        end;
      end;

      case UnderlyingType.TypeKind of
        tkInteger, tkInt64:
          FmtType := tiInteger;
        tkFloat:
          begin
            if UnderlyingType.Handle = TypeInfo(TDateTime) then
              FmtType := tiDateTime
            else
              FmtType := tiFloat;
          end;
        tkString, tkLString, tkWString, tkUString:
          FmtType := tiString;
        tkEnumeration:
          if UnderlyingType.Handle = TypeInfo(Boolean) then
            FmtType := tiBoolean
          else
            FmtType := tiString;
        tkVariant:
          FmtType := tiString;
        else
          FmtType := tiNone;
      end;
    end;

    // Extract actual value from TNullable<T> if necessary
    if Value.Kind = tkRecord then
    begin
      // Assuming TNullable<T> has 'HasValue' and 'Value' fields
      UnderlyingType := Prop.PropertyType;
      HasValueField := UnderlyingType.GetField('HasValue');
      ValueField := UnderlyingType.GetField('Value');

      if Assigned(HasValueField) and Assigned(ValueField) then
      begin
        HasValue := HasValueField.GetValue(Value.GetReferenceToRawData).AsBoolean;
        if HasValue then
        begin
          ActualValue := ValueField.GetValue(Value.GetReferenceToRawData);
          // Format the actual value
          Result := FormataInfo(ActualValue.AsVariant, FmtType);
        end
        else
          Result := EmptyStr;
      end
      else
      begin
        // Not TNullable<T>, handle value directly
        if not Value.IsEmpty then
          Result := FormataInfo(Value.AsVariant, FmtType)
        else
          Result := EmptyStr;
      end;
    end
    else
    begin
      // Not a record, handle value directly
      if not Value.IsEmpty then
        Result := FormataInfo(Value.AsVariant, FmtType)
      else
        Result := EmptyStr;
    end;
  finally
    Ctx.Free;
  end;
end;

constructor TQryRecInfo.Create;
begin
  inherited;
  FDirtyFields := TDictionary<string, Boolean>.Create;
  FPreviousValues := TDictionary<string, TValue>.Create;
end;

destructor TQryRecInfo.Destroy;
begin
  FDirtyFields.Free;
  FPreviousValues.Free;
  inherited;
end;

function GetPropNameAndField(Cls: TClass; PropIndex: integer; var PropName: string; var PropKind: TTypeKind): Boolean;
var
  Ctx: TRttiContext;
  Prop: TRttiProperty;
begin
  PropName := '';
  Ctx := TRttiContext.Create;
  for Prop in Ctx.GetType(Cls).GetProperties do
  begin
    if (Prop as TRttiInstanceProperty).Index = PropIndex then
    begin
      PropName := Prop.Name;
      PropKind := Prop.PropertyType.TypeKind;
      Break;
    end;
  end;
  Result := (PropName <> '');
end;

procedure TQryRecInfo.Set_Info(Index: integer; const Value: TValue);
var
  PropName: string;
  PropKind: TTypeKind;
  Ctx: TRttiContext;
  Field: TRttiField;
  OldValue: TValue;
begin
  if not GetPropNameAndField(Self.ClassType, Index, PropName, PropKind) then
    raise Exception.Create('Error: The index "' + Index.ToString + '" does not exist in class "' + ClassType.ClassName + '"');

  Ctx := TRttiContext.Create;
  try
    Field := Ctx.GetType(Self.ClassType).GetField('_' + PropName);
    if Assigned(Field) then
    begin
      // If the field is not yet dirty, store the previous value
      if not FDirtyFields.ContainsKey(PropName) then
      begin
        OldValue := Field.GetValue(Self);
        FPreviousValues.AddOrSetValue(PropName, OldValue);
      end;
      // Set the new value
      Field.SetValue(Self, Value);
      // Mark the property as dirty
      FDirtyFields.AddOrSetValue(PropName, True);
    end
    else
      raise Exception.Create('Error: Field "_' + PropName + '" not found.');
  finally
    // TRttiContext is a record; no need to free
  end;
end;

procedure TQryRecInfo.Set_Info_NullableBoolean(Index: integer; const Value: TNullable<Boolean>);
begin
  Set_Info(Index, TValue.From<TNullable<Boolean>>(Value));
end;

procedure TQryRecInfo.Set_Info_NullableCurrency(Index: integer; const Value: TNullable<Currency>);
begin
  Set_Info(Index, TValue.From<TNullable<Currency>>(Value));
end;

procedure TQryRecInfo.Set_Info_NullableDateTime(Index: integer; const Value: TNullable<TDateTime>);
begin
  Set_Info(Index, TValue.From<TNullable<TDateTime>>(Value));
end;

procedure TQryRecInfo.Set_Info_NullableExtended(Index: integer; const Value: TNullable<Extended>);
begin
  Set_Info(Index, TValue.From<TNullable<Extended>>(Value));
end;

procedure TQryRecInfo.Set_Info_NullableInteger(Index: integer; const Value: TNullable<Integer>);
begin
  Set_Info(Index, TValue.From<TNullable<Integer>>(Value));
end;

procedure TQryRecInfo.Set_Info_NullableInt64(Index: integer; const Value: TNullable<Int64>);
begin
  Set_Info(Index, TValue.From<TNullable<Int64>>(Value));
end;

procedure TQryRecInfo.Set_Info_NullableString(Index: integer; const Value: TNullable<string>);
begin
  Set_Info(Index, TValue.From<TNullable<string>>(Value));
end;

procedure TQryRecInfo.Set_Info_NullableVariant(Index: integer; const Value: TNullable<Variant>);
begin
  Set_Info(Index, TValue.From<TNullable<Variant>>(Value));
end;

// Method to check if a field is dirty
function TQryRecInfo.IsFieldDirty(const FieldName: string): Boolean;
begin
  Result := FDirtyFields.ContainsKey(FieldName);
end;

// Method to clear all dirty flags
procedure TQryRecInfo.ClearDirtyFlags;
begin
  FDirtyFields.Clear;
end;

// Method to get the previous value of a property
function TQryRecInfo.GetPreviousValue(const FieldName: string): TValue;
begin
  if FPreviousValues.TryGetValue(FieldName, Result) then
    Exit;
  // Return some default value or raise exception if not found
  raise Exception.CreateFmt('No previous value found for field "%s".', [FieldName]);
end;

// Method to clear previous values
procedure TQryRecInfo.ClearPreviousValues;
begin
  FPreviousValues.Clear;
end;

procedure TQryRecInfo.Fetch(DBConn: TUniConnection; QryTxt: string);
begin
 if Assigned(DBConn) and (Trim(QryTxt) <> '') then
 begin
  var
  qr:= TUniQuery.Create(nil);
  qr.Connection:= DBConn;

  qr.SpecificOptions.Values['FetchAll']:= 'True';
  qr.SpecificOptions.Values['CreateConnection']:= 'False';

  qr.SQL.Text:= QryTxt;
  qr.Open;
  writeln(QryTxt); readln;
  if qr.RecordCount > 0 then
  begin
   try
   var Ctx: TRttiContext;
   Ctx:= TRttiContext.Create;

   var ObjType := Ctx.GetType(ClassType);
   var Prop: TRttiProperty;
   for Prop in ObjType.GetProperties do
    begin
     if not Prop.IsWritable then Continue;

     var Field := qr.FindField(Prop.Name);
     if not Assigned(Field) then Continue;

     case Prop.PropertyType.TypeKind of
      tkRecord:
       begin
        if Prop.PropertyType.Name = 'TNullable<System.string>' then
        begin
        Ctx.GetType(ClassType).GetField('_' + Prop.Name).SetValue(Self, TValue.From<TNullable<string>>(Field.Value));
        end;
       end;

      tkString, tkLString, tkWString, tkUString: Ctx.GetType(ClassType).GetField('_' + Prop.Name).SetValue(Pointer(Self), TValue.From<TNullable<string>>(Field.Value));
     end;
    end;

   except
     on E:Exception do
      begin
       writeln(E.Message);
       readln;
      end;

    end;

   end;
   qr.Free;
  end;
end;

end.

--------------------

unit ORM_CustomAttributes;

{$TYPEINFO ON}

interface

uses
  System.SysUtils, System.Classes, System.Rtti;

type
  TFormatType = (tiString, tiInteger, tiDate, tiDateTime, tiMoney, tiFloat, tiBoolean, tiByteArray, tiNone);

  /// <summary>
  /// Attribute to specify the database table associated with a class or field.
  /// </summary>
  TableAttribute = class(TCustomAttribute)
  private
    FTableName: string;
  public
    constructor Create(const ATableName: string);
    property TableName: string read FTableName;
  end;

  /// <summary>
  /// Attribute to mark a field as a primary key.
  /// </summary>
  PrimaryKeyAttribute = class(TCustomAttribute)
  public
    constructor Create;
  end;

  /// <summary>
  /// Attribute to specify the database column associated with a field.
  /// </summary>
  RefColumnAttribute = class(TCustomAttribute)
  private
    FColumnName: string;
  public
    constructor Create(const AColumnName: string);
    property ColumnName: string read FColumnName;
  end;

  /// <summary>
  /// Attribute to specify the formatting of a field.
  /// </summary>
  FmtPropAttribute = class(TCustomAttribute)
  private
    FFormatType: TFormatType;
  public
    constructor Create(AFormatType: TFormatType);
    property FormatType: TFormatType read FFormatType;
  end;

implementation

{ TableAttribute }

constructor TableAttribute.Create(const ATableName: string);
begin
  inherited Create;
  FTableName := ATableName;
end;

{ RefColumnAttribute }

constructor RefColumnAttribute.Create(const AColumnName: string);
begin
  inherited Create;
  FColumnName := AColumnName;
end;

{ PrimaryKeyAttribute }

constructor PrimaryKeyAttribute.Create;
begin
  inherited Create;
end;

{ FmtPropAttribute }

constructor FmtPropAttribute.Create(AFormatType: TFormatType);
begin
  inherited Create;
  FFormatType := AFormatType;
end;

end.

-----------------

unit pixel_classes;

interface

uses
 System.SysUtils, Rtti, TypInfo;

{$TYPEINFO ON}

type
 TZString = type string;

type
  TNullValue = record
  end;

  TNullable<T{: record}> = record
  public
    Value: T;
    HasValue: Boolean;

    class operator Implicit(const AValue: T): TNullable<T>;
    class operator Implicit(const AValue: TNullable<T>): T;
    class operator Implicit(const AValue: TNullValue): TNullable<T>;
    class operator Explicit(const AValue: T): TNullable<T>;

    // add these...
    class operator Equal(const A: TNullable<T>; const B: TNullValue): Boolean;
    class operator NotEqual(const A: TNullable<T>; const B: TNullValue): Boolean;
  end;

var NullValue: TNullValue;

implementation

class operator TNullable<T>.Implicit(const AValue: T): TNullable<T>;
begin
  Result.Value := AValue;
  Result.HasValue := True;
end;

class operator TNullable<T>.Implicit(const AValue: TNullable<T>): T;
begin
  if AValue.HasValue then
    Result := AValue.Value
  else
    Result := Default(T); // or raise an exception
end;

class operator TNullable<T>.Implicit(const AValue: TNullValue): TNullable<T>;
begin
  Result.Value := Default(T);
  Result.HasValue := False;
end;

class operator TNullable<T>.Explicit(const AValue: T): TNullable<T>;
begin
  Result.Value := AValue;
  Result.HasValue := True;
end;

class operator TNullable<T>.Equal(const A: TNullable<T>; const B: TNullValue): Boolean;
begin
  Result := not A.HasValue;
end;

class operator TNullable<T>.NotEqual(const A: TNullable<T>; const B: TNullValue): Boolean;
begin
  Result := A.HasValue;
end;

end.

-----------------------

Carefully review the Delphi units above, then complete the TQryRecInfo.Fetch code for all the TNullable variations:

TNullable<string>
TNullable<Integer>
TNullable<Int64>
TNullable<Extended>
TNullable<Currency>
TNullable<TDateTime>
TNullable<Boolean>
TNullable<Variant>