unit formgerenc_Classes;

{$TYPEINFO ON}

interface

uses
  orm_utils, pixel_classes;

type
  TProspect = class(TQryRecInfo)
  private
    _ID: TNullable<Integer>;
    _Nome: TNullable<string>;
  published
    property ID: TNullable<Integer> index 0 read _ID write Set_Info_NullableInteger;
    property Nome: TNullable<string> index 1 read _Nome write Set_Info_NullableString;
  end;

implementation

end.

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

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_utils;

{$TYPEINFO ON}

interface

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

type
  TQryRecInfo = class
  private
    procedure Set_Info(Index: integer; const Value: Variant);
  public
    procedure Set_Info_String(Index: integer; const Value: string); overload;
    procedure Set_Info_Integer(Index: integer; const Value: Integer); overload;

    // New methods to handle TNullable<T>
    procedure Set_Info_NullableString(Index: integer; const Value: TNullable<string>);
    procedure Set_Info_NullableInteger(Index: integer; const Value: TNullable<Integer>);
  end;

implementation

function GetPropNameAndField(Cls: TClass; PropIndex: integer; var PropName: string; var PropKind: TTypeKind): Boolean;
var
 Ctx: TRttiContext;
 Prop: TRttiProperty;
 Attr: TCustomAttribute;
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: Variant);
begin
  // Implementation of setting the value

 var PropName: string;
 var PropKind: TTypeKind;

 if not GetPropNameAndField(ClassType, index, PropName, PropKind) then raise Exception.Create('ERRO: O índice "' + index.ToString + '" não existe na Classe "' + ClassType.ClassName + '"');

 var Ctx: TRttiContext;
 Ctx:= TRttiContext.Create;
 Ctx.GetType(Self.ClassType).GetField('_' + PropName).SetValue(Pointer(Self), TValue.FromVariant(Value));
end;

procedure TQryRecInfo.Set_Info_String(Index: integer; const Value: string);
begin
  Set_Info(Index, Value);
end;

procedure TQryRecInfo.Set_Info_Integer(Index: integer; const Value: Integer);
begin
  Set_Info(Index, Value);
end;

// Implementation of new methods for TNullable<T>

procedure TQryRecInfo.Set_Info_NullableString(Index: integer; const Value: TNullable<string>);
begin
  if Value.HasValue then
    Set_Info(Index, Value.Value)
  else
    Set_Info(Index, Null);
end;

procedure TQryRecInfo.Set_Info_NullableInteger(Index: integer; const Value: TNullable<Integer>);
begin
  if Value.HasValue then
    Set_Info(Index, Value.Value)
  else
    Set_Info(Index, Null);
end;

end.

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

unit ORM_Test;

interface

procedure Test_ORM1;

implementation

uses
  formgerenc_Classes, pixel_classes, SysUtils;

procedure Test_ORM1;
var
  Prospect: TProspect;
begin
  Prospect := TProspect.Create;
  try
    // Assign a value to the ID property
    Prospect.ID := 123;

    // Assign null to the Nome property
    Prospect.Nome := NullValue; // Assuming NullValue is defined in your pixel_classes unit

    // Access the properties
    if Prospect.ID.HasValue then
      Writeln('ID: ', Prospect.ID.Value)
    else
      Writeln('ID is null');

    if Prospect.Nome.HasValue then
      Writeln('Nome: ', Prospect.Nome.Value)
    else
      Writeln('Nome is null');
  finally
    Prospect.Free;
  end;
end;

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

Please fix the code, knowing that when I set 
Prospect.ID := 123;
It gives an error ov invalid class typecast