Objective

Create a generic TQryRecInfoArray<T> class that:

    Accepts a SQL SELECT query.
    Executes the query using TUniQuery.
    Uses RTTI to map query fields to class properties based on field names.
    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.
    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);

end.

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

unit formgerenc_Classes;

{$TYPEINFO ON}

interface

uses
  orm_utils, pixel_classes, ORM_CustomAttributes;

type
  TEmployeeProject = class(TQryRecInfo)
  private
    _EmployeeID: TNullable<Integer>;
    _DepartmentID: TNullable<Integer>;
    _EmployeeName: TNullable<String>;
    _ProjectID: TNullable<Integer>;
    _ProjectName: TNullable<String>;
    _ProjectBudget: TNullable<Currency>;
    _ProjectDate: TNullable<TDateTime>;
    _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.

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