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.Implicit(const AValue: T): TNullable;
begin
Result.Value := AValue;
Result.HasValue := True;
end;

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

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

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

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

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

end.

unit orm_utils;

interface

uses
System.SysUtils,
System.Classes,
System.Generics.Collections,
System.Generics.Defaults,
System.Rtti,
System.TypInfo,
Data.DB,
Uni,
pixel_classes,
orm_customattributes,
Vcl.Controls,
Vcl.Forms,
Dialogs,
Variants;

type
TQryRecInfo = class;

// Define the event type
TPropertyChangedEvent = procedure(Sender: TQryRecInfo; const PropertyName: string) of object;

EORMUtilsException = class(Exception);

///

/// Represents the key used in the component-ORM mapping dictionary.
/// Combines a reference to an ORM record with a specific field name.
///

TORMKey = record
ORMRec: TQryRecInfo;
FieldName: string;
end;

///

/// Custom comparer for TORMKey to handle equality checks and hashing.
///

TORMKeyComparer = class(TEqualityComparer)
function Equals(const Left, Right: TORMKey): Boolean; override;
function GetHashCode(const Key: TORMKey): Integer; override;
end;

///

/// Manages the binding between UI components and ORM records.
///

TORMManager = class
private
FComponentDict: TDictionary<TORMKey, TComponent>;
public
constructor Create;
destructor Destroy; override;

/// <summary>
/// Registers a component with its corresponding ORM record and field name.
/// </summary>
procedure RegisterComponent(Component: TComponent; ORMRec: TQryRecInfo; const FieldName: string);

/// <summary>
/// Unregisters a component from ORM binding.
/// </summary>
procedure UnregisterComponent(Component: TComponent);

/// <summary>
/// Finds the component associated with a specific ORM record and field name.
/// </summary>
function FindComponent(ORMRec: TQryRecInfo; const FieldName: string): TComponent;

/// <summary>
/// Retrieves all registered components.
/// </summary>
function GetAllComponents: TArray<TComponent>;

/// <summary>
/// Updates a component's UI based on the latest ORM record data.
/// </summary>
procedure UpdateComponentFromORM(Component: TComponent; ORMRec: TQryRecInfo; const FieldName: string);

/// <summary>
/// Retrieves the ORM record associated with a given component.
/// </summary>
function GetORMRecForComponent(Component: TComponent): TQryRecInfo;

/// <summary>
/// Retrieves the field name associated with a given component.
/// </summary>
function GetFieldNameForComponent(Component: TComponent): string;

/// <summary>
/// Registers components based on their Hint property.
/// </summary>
procedure RegisterComponentsByHint(MyForm: TForm; ORMRec: TQryRecInfo);

end;

///

/// Helper methods extending TComponent to interface with ORMManager.
///

TComponentHelper = class helper for TComponent
public
///

/// Retrieves the ORM record associated with the component.
///

function GetORMRec: TQryRecInfo;

/// <summary>
/// Retrieves the field name associated with the component.
/// </summary>
function GetORMRecField: string;

end;

///

/// Base class for query record information
/// Use descendants of this class to represent specific database records.
///

TQryRecInfo = class
private
FDirtyFields: TDictionary<string, Boolean>;
FPreviousValues: TDictionary<string, TValue>;
FOnPropertyChanged: TPropertyChangedEvent; // New event
FIsNewRec: Boolean; // New field

procedure SetInfo(Index: Integer; const Value: TValue);
// Other SetInfo overloads...

public
constructor Create;
destructor Destroy; override;

// Event property
property OnPropertyChanged: TPropertyChangedEvent read FOnPropertyChanged write FOnPropertyChanged;

// New property
property IsNewRec: Boolean read FIsNewRec;

// Methods to set nullable fields
procedure SetInfoNullableString(Index: Integer; const Value: TNullable<string>);
procedure SetInfoNullableInteger(Index: Integer; const Value: TNullable<Integer>);
procedure SetInfoNullableInt64(Index: Integer; const Value: TNullable<Int64>);
procedure SetInfoNullableExtended(Index: Integer; const Value: TNullable<Extended>);
procedure SetInfoNullableCurrency(Index: Integer; const Value: TNullable<Currency>);
procedure SetInfoNullableDateTime(Index: Integer; const Value: TNullable<TDateTime>);
procedure SetInfoNullableBoolean(Index: Integer; const Value: TNullable<Boolean>);
procedure SetInfoNullableVariant(Index: Integer; const Value: TNullable<Variant>);

// Methods to set non-nullable simple types
procedure SetInfoCurrency(Index: Integer; const Value: Currency);
procedure SetInfoString(Index: Integer; const Value: string);
procedure SetInfoInteger(Index: Integer; const Value: Integer);
procedure SetInfoInt64(Index: Integer; const Value: Int64);
procedure SetInfoExtended(Index: Integer; const Value: Extended);
procedure SetInfoDateTime(Index: Integer; const Value: TDateTime);
procedure SetInfoBoolean(Index: Integer; const Value: Boolean);
procedure SetInfoVariant(Index: Integer; const Value: 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;

/// <summary>
/// Fetches data for this record from the database based on the provided SQL.
/// </summary>
procedure Fetch(DBConn: TUniConnection; const QryTxt: string);

/// <summary>
/// Retrieves the value of a property by name.
/// </summary>
/// <param name="PropertyName">The name of the property to retrieve.</param>
/// <returns>The value of the specified property as TValue.</returns>
function GetPropertyValue(const PropertyName: string): TValue; // New method

end;

///

/// Generic class to handle arrays of TQryRecInfo descendants.
///

TQryRecArray<T: TQryRecInfo, constructor> = class
private
FQryRecInfoList: TObjectList;
FFilterSQL: string;
FDBConn: TUniConnection;
function GetCount: Integer;
public
constructor Create;
destructor Destroy; override;

/// <summary>
/// Fetches all records based on the provided SQL text and populates the array.
/// </summary>
/// <param name="QryTxt">The base SQL query text.</param>
procedure FetchAllInstance(DBConn: TUniConnection; const QryTxt: string);

/// <summary>
/// Clears any SQL filters applied.
/// </summary>
procedure ClearFilter;

/// <summary>
/// Accesses a record at the specified index.
/// </summary>
/// <param name="Index">The zero-based index of the record.</param>
/// <returns>The record at the specified index.</returns>
function Rec(Index: Integer): T;

/// <summary>
/// Number of records in the array.
/// </summary>
property RecCount: Integer read GetCount;

/// <summary>
/// Database connection used for fetching records.
/// </summary>
property DBConn: TUniConnection read FDBConn write FDBConn;

/// <summary>
/// Additional SQL filter to apply to the query.
/// </summary>
property SQLFilter: string read FFilterSQL write FFilterSQL;

/// <summary>
/// Provides support for for-in loops by returning an enumerator.
/// </summary>
function GetEnumerator: TEnumerator<T>;

/// <summary>
/// Factory method to create and fetch records in a single step.
/// </summary>
/// <param name="DBConn">Database connection.</param>
/// <param name="QryTxt">SQL query text.</param>
/// <returns>Populated instance of TQryRecArray<T>.</returns>
class function FetchAll(DBConn: TUniConnection; const QryTxt: string): TQryRecArray<T>; static;

end;

// Declare ORMManager as a global variable in the interface for accessibility
var
ORMManager: TORMManager;

implementation

uses
pixel_utils,
System.Math,
System.Types,
Windows,
Vcl.StdCtrls,
Vcl.WinXCtrls,
Vcl.WinXPickers,
StrUtils,
DateUtils,
System.Hash;

// =============================
// TORMKeyComparer Implementation
// =============================

function TORMKeyComparer.Equals(const Left, Right: TORMKey): Boolean;
begin
Result := (Left.ORMRec = Right.ORMRec) and SameText(Left.FieldName, Right.FieldName);
end;

function TORMKeyComparer.GetHashCode(const Key: TORMKey): Integer;
begin
Result := Integer(NativeUInt(Key.ORMRec)) xor THashBobJenkins.GetHashValue(LowerCase(Key.FieldName));
end;

// =============================
// TORMManager Implementation
// =============================

constructor TORMManager.Create;
begin
inherited Create;
FComponentDict := TDictionary<TORMKey, TComponent>.Create(TORMKeyComparer.Create);
end;

destructor TORMManager.Destroy;
begin
FComponentDict.Free;
inherited;
end;

procedure TORMManager.RegisterComponent(Component: TComponent; ORMRec: TQryRecInfo; const FieldName: string);
var
Key: TORMKey;
begin
Key.ORMRec := ORMRec;
Key.FieldName := FieldName;

if not FComponentDict.ContainsKey(Key) then
begin
FComponentDict.Add(Key, Component);
end;
end;

procedure TORMManager.UnregisterComponent(Component: TComponent);
var
Key: TORMKey;
CopyKeys: TArray;
i: Integer;
begin
// To safely remove components, first copy the keys
CopyKeys := FComponentDict.Keys.ToArray;
for i := 0 to Length(CopyKeys) - 1 do
begin
Key := CopyKeys[i];
if FComponentDict[Key] = Component then
FComponentDict.Remove(Key);
end;
end;

function TORMManager.FindComponent(ORMRec: TQryRecInfo; const FieldName: string): TComponent;
var
Key: TORMKey;
begin
Key.ORMRec := ORMRec;
Key.FieldName := FieldName;
if FComponentDict.TryGetValue(Key, Result) then
Exit
else
Result := nil;
end;

---

How many tokens are in this conversation up to now?