Objective

Create a generic TQryRecArray<T> class that:

    Accepts a SQL SELECT query.
    Executes the query using TUniQuery.
    Uses RTTI to map query fields to class properties based on custom attributes (RefColumnAttribute).
    Populates a list of class instances with the query data.
    Assume that the field names in the query exactly match the property names and respective data types in the class.

Implementation Steps

    Define the Generic TQryRecArray<T> Class.
    Implement the code Using RTTI.
    Ensure Proper Handling of TNullable<> Types and NULL Values.
    Provide Usage Example.


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

unit pixel_classes;

interface

uses
 System.SysUtils, Rtti, TypInfo;

{$TYPEINFO ON}

type
 TZString = type string;

type
 TPixelUtils = class
  published
   class procedure CopyObject<T: class>(ASourceObject, ATargetObject: T);
   class function ObjectCopyFrom<T: class>(ASourceObject: T): T;
   class function EnumerationToString<T: record>(Value: T): string;
   class function StringToEnumeration<T: record>(const S: string): T;
 end;

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;

{ // exemplo de uso do TNullable

  var v: TNullable<Integer>;

  v := NullValue;
  v:= 98;

  if v = NullValue then begin
    showmessage('é null');
  end;

  if v <> NullValue then begin
    showmessage('é: '+IntToStr(v));
  end;

}

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;

class procedure TPixelUtils.CopyObject<T>(ASourceObject, ATargetObject: T);
const
 SKIP_PROP_TYPES = [tkUnknown, tkInterface, tkClassRef, tkPointer, tkProcedure];
var
 ctx: TRttiContext;
 rType: TRttiType;
 rProp: TRttiProperty;
 AValue, ASource, ATarget: TValue;
begin
 Assert(Assigned(ASourceObject) and Assigned(ATargetObject), 'Both objects must be assigned');
 ctx:= TRttiContext.Create;
 rType:= ctx.GetType(ASourceObject.ClassInfo);
 ASource:= TValue.From<T>(ASourceObject);
 ATarget:= TValue.From<T>(ATargetObject);

 for rProp in rType.GetProperties do
 begin  // showmessage(TRttiEnumerationType.GetName<TTypeKind>(rProp.PropertyType.TypeKind)+#13+rProp.Name);
  if (rProp.IsReadable) and (rProp.IsWritable) and not (rProp.PropertyType.TypeKind in SKIP_PROP_TYPES) then
  begin
   // when copying visual controls you must skip some properties or you will get some exceptions later
   if SameText(rProp.Name, 'Name') or (SameText(rProp.Name, 'WindowProc')) then Continue;
   AValue:= rProp.GetValue(ASource.AsObject);
   rProp.SetValue(ATarget.AsObject, AValue);
  end;
 end;
end;

class function TPixelUtils.ObjectCopyFrom<T>(ASourceObject: T): T;
const
 SKIP_PROP_TYPES = [tkUnknown, tkInterface, tkClass, tkClassRef, tkPointer, tkProcedure];
var
 ctx: TRttiContext;
 rType: TRttiType;
 rProp: TRttiProperty;
 AValue, ASource, ATarget: TValue;
begin
 Assert(Assigned(ASourceObject), 'Source object must be assigned');
 Result:= T(GetTypeData(PTypeInfo(TypeInfo(T)))^.ClassType.Create);
 ctx:= TRttiContext.Create;
 rType:= ctx.GetType(ASourceObject.ClassInfo);
 ASource:= TValue.From<T>(ASourceObject);
 ATarget:= TValue.From<T>(Result);

 for rProp in rType.GetProperties do
 begin
  if (rProp.IsReadable) and (rProp.IsWritable) and not (rProp.PropertyType.TypeKind in SKIP_PROP_TYPES) then
  begin
   // when copying visual controls you must skip some properties or you will get some exceptions later
   if SameText(rProp.Name, 'Name') or (SameText(rProp.Name, 'WindowProc')) then Continue;
   AValue:= rProp.GetValue(ASource.AsObject);
   rProp.SetValue(ATarget.AsObject, AValue);
  end;
 end;
end;

class function TPixelUtils.EnumerationToString<T>(Value: T): string;
var
  P: PTypeInfo;
begin
  P := PTypeInfo(TypeInfo(T));
  case P^.Kind of
    tkEnumeration:
      case GetTypeData(P)^.OrdType of
        otSByte, otUByte:
          Result := GetEnumName(P, PByte(@Value)^);
        otSWord, otUWord:
          Result := GetEnumName(P, PWord(@Value)^);
        otSLong, otULong:
          Result := GetEnumName(P, PCardinal(@Value)^);
      end;
    else
      raise EArgumentException.CreateFmt('Type %s is not enumeration', [P^.Name]);
  end;
end;

class function TPixelUtils.StringToEnumeration<T>(const S: string): T;
var
  P: PTypeInfo;
begin
  P := PTypeInfo(TypeInfo(T));
  case P^.Kind of
    tkEnumeration:
      case GetTypeData(P)^.OrdType of
        otSByte, otUByte:
          PByte(@Result)^ := GetEnumValue(P, S);
        otSWord, otUWord:
          PWord(@Result)^ := GetEnumValue(P, S);
        otSLong, otULong:
          PCardinal(@Result)^ := GetEnumValue(P, S);
      end;
    else
      raise EArgumentException.CreateFmt('Type %s is not enumeration', [P^.Name]);
  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 formgerenc_Classes;

{$TYPEINFO ON}

interface

uses
  orm_utils, pixel_classes, ORM_CustomAttributes;

type
  TEmployeeProject = class(TQryRecInfo)
  private
    [Table('employees'), PrimaryKey, RefColumn('emp_id')]
    _EmployeeID: TNullable<Integer>;
    [Table('employees'), PrimaryKey, RefColumn('dept_id')]
    _DepartmentID: TNullable<Integer>;
    [Table('employees'), RefColumn('emp_name')]
    _EmployeeName: TNullable<String>;
    [Table('projects'), PrimaryKey, RefColumn('proj_id')]
    _ProjectID: TNullable<Integer>;
    [Table('projects'), RefColumn('proj_name')]
    _ProjectName: TNullable<String>;
    [Table('projects'), RefColumn('proj_budget'), FmtProp(tiMoney)]
    _ProjectBudget: TNullable<Currency>;
    [Table('projects'), RefColumn('proj_date'), FmtProp(tiDate)]
    _ProjectDate: TNullable<TDateTime>;
    [Table('projects'), RefColumn('proj_starttime'), FmtProp(tiDateTime)]
    _ProjectStartMoment: TNullable<TDateTime>;

  published
    property EmployeeID: TNullable<Integer> index 0 read _EmployeeID write Set_Info_NullableInteger;
    property DepartmentID: TNullable<Integer> index 1 read _DepartmentID write Set_Info_NullableInteger;
    property EmployeeName: TNullable<String> index 2 read _EmployeeName write Set_Info_NullableString;
    property ProjectID: TNullable<Integer> index 3 read _ProjectID write Set_Info_NullableInteger;
    property ProjectName: TNullable<String> index 4 read _ProjectName write Set_Info_NullableString;
    property ProjectBudget: TNullable<Currency> index 5 read _ProjectBudget write Set_Info_NullableCurrency;
    property ProjectDate: TNullable<TDateTime> index 6 read _ProjectDate write Set_Info_NullableDateTime;
    property ProjectStartMoment: TNullable<TDateTime> index 7 read _ProjectStartMoment write Set_Info_NullableDateTime;
  end;

implementation

end.

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

unit QueryClassPopulator;

interface

uses
  System.SysUtils, System.Classes, System.Rtti, Data.DB, Variants, Uni, TypInfo;

type
  TQueryClassPopulator = class
  public
    class procedure PopulateClassFromQuery<T: class, constructor>(AQuery: TUniQuery; var AObject: T);
  end;

implementation

class procedure TQueryClassPopulator.PopulateClassFromQuery<T>(AQuery: TUniQuery; var AObject: T);
var
  Context: TRttiContext;
  RttiType: TRttiType;
  RttiProperty: TRttiProperty;
  Field: TField;
  PropName: string;
  PropValue: TValue;
begin
  if not Assigned(AQuery) or not Assigned(AObject) then
    Exit;

  Context := TRttiContext.Create;
  try
    RttiType := Context.GetType(TypeInfo(T));

    for Field in AQuery.Fields do
    begin
      PropName := Field.FieldName;

      // Find the corresponding property in the class
      RttiProperty := RttiType.GetProperty(PropName);
      if not Assigned(RttiProperty) then
        Continue;

      // Check if the property type is TNullable<T>
      if RttiProperty.PropertyType.Name.StartsWith('TNullable<') then
      begin
        if Field.IsNull then
        begin
          // Set the property to a null value
          PropValue := TValue.From<Variant>(Null);
        end
        else
        begin
          // Set the property to the field value
          case Field.DataType of
            ftString, ftWideString, ftMemo, ftWideMemo:
              PropValue := TValue.From<string>(Field.AsString);
            ftInteger, ftSmallint, ftWord:
              PropValue := TValue.From<Integer>(Field.AsInteger);
            ftLargeint:
              PropValue := TValue.From<Int64>(Field.AsLargeInt);
            ftFloat, ftCurrency, ftBCD:
              PropValue := TValue.From<Double>(Field.AsFloat);
            ftBoolean:
              PropValue := TValue.From<Boolean>(Field.AsBoolean);
            ftDate, ftDateTime, ftTimeStamp:
              PropValue := TValue.From<TDateTime>(Field.AsDateTime);
            else
              PropValue := TValue.FromVariant(Field.Value);
          end;
        end;

        // Set the property value
        RttiProperty.SetValue(TObject(AObject), PropValue);
      end;
    end;
  finally
    Context.Free;
  end;
end;

end.

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

Analyze and Enhance the QueryClassPopulator unit