unit ORM_GenerateDelphiClassFromQuery;

interface

uses
  Uni, DB, System.Generics.Collections, SysUtils, System.Character, System.Classes, SQLParserEnhanced;

function GenerateDelphiClassFromQuery(const SQLText: string; const ClassName: string; AConnection: TUniConnection): string;

implementation

function GenerateDelphiClassFromQuery(const SQLText: string; const ClassName: string; AConnection: TUniConnection): string;
var
  Parser: TSQLParser;
  ColumnInfo: TSQLColumnInfo;
  i, PropIndex: Integer;
  FieldsList: TObjectList<TSQLColumnInfo>;
  AttrsLine: string;
  FieldName, PropertyName: string;
  NullableDelphiType, WriteMethod: string;
  ResultList: TStringList;
  AttributesList: TList<string>;

  function CreateValidIdentifier(const Name: string): string;
  var
    i: Integer;
    c: Char;
  begin
    Result := '';
    for i := 1 to Length(Name) do
    begin
      c := Name[i];
      if c.IsLetterOrDigit or (c = '_') then
        Result := Result + c
      else
        Result := Result + '_'; // Replace invalid chars with '_'
    end;
    // Ensure the identifier does not start with a digit or invalid character
    if (Result = '') or not (Result[1].IsLetter or (Result[1] = '_')) then
      Result := '_' + Result;
  end;

  function GetDelphiTypeMapping(FieldType: TFieldType; out NullableDelphiType, WriteMethod: string): Boolean;
  begin
    Result := True;
    case FieldType of
      TFieldType.ftString, TFieldType.ftWideString, TFieldType.ftMemo, TFieldType.ftWideMemo:
      begin
        NullableDelphiType := 'TNullable<String>';
        WriteMethod := 'Set_Info_NullableString';
      end;
      TFieldType.ftInteger, TFieldType.ftByte, TFieldType.ftSmallint, TFieldType.ftWord, TFieldType.ftLongWord, TFieldType.ftShortint:
      begin
        NullableDelphiType := 'TNullable<Integer>';
        WriteMethod := 'Set_Info_NullableInteger';
      end;
      TFieldType.ftLargeint:
      begin
        NullableDelphiType := 'TNullable<Int64>';
        WriteMethod := 'Set_Info_NullableInt64';
      end;
      TFieldType.ftSingle, TFieldType.ftFloat, TFieldType.ftExtended:
      begin
        NullableDelphiType := 'TNullable<Extended>';
        WriteMethod := 'Set_Info_NullableExtended';
      end;
      TFieldType.ftDate, TFieldType.ftTime, TFieldType.ftDateTime, TFieldType.ftTimeStamp:
      begin
        NullableDelphiType := 'TNullable<TDateTime>';
        WriteMethod := 'Set_Info_NullableDateTime';
      end;
      TFieldType.ftCurrency:
      begin
        NullableDelphiType := 'TNullable<Currency>';
        WriteMethod := 'Set_Info_NullableCurrency';
      end;
      TFieldType.ftFMTBcd, TFieldType.ftBCD:
      begin
        NullableDelphiType := 'TNullable<Currency>';
        WriteMethod := 'Set_Info_NullableCurrency';
      end;
      TFieldType.ftBoolean:
      begin
        NullableDelphiType := 'TNullable<Boolean>';
        WriteMethod := 'Set_Info_NullableBoolean';
      end;
      else
      begin
        NullableDelphiType := 'TNullable<Variant>';
        WriteMethod := 'Set_Info_NullableVariant';
        Result := False;
      end;
    end;
  end;

begin
  ResultList := TStringList.Create;
  try
    ResultList.Add('type');
    ResultList.Add(Format('  T%s = class(TQryRecInfo)', [ClassName]));
    ResultList.Add('  private');

    Parser := TSQLParser.Create(SQLText, AConnection);
    try
      FieldsList := Parser.Columns;  // Get the columns info

      // Iterate over the columns to generate field declarations
      for i := 0 to FieldsList.Count - 1 do
      begin
        ColumnInfo := FieldsList[i];

        if not GetDelphiTypeMapping(ColumnInfo.DataType, NullableDelphiType, WriteMethod) then
        begin
          // Handle unsupported type if necessary
        end;

        // Use QueryColumnAlias as the field name or the column name
        if ColumnInfo.QueryColumnAlias <> '' then
          FieldName := ColumnInfo.QueryColumnAlias
        else
          FieldName := ColumnInfo.ReferencedTableColumn;

        // Sanitize the FieldName (remove special characters, etc.)
        FieldName := CreateValidIdentifier(FieldName);
        FieldName := '_' + FieldName; // Prefix with '_'

        // Initialize the list of attributes
        AttributesList := TList<string>.Create;
        try
          // Build custom attributes
          if not ColumnInfo.RealTableName.IsEmpty and
             not ((ColumnInfo.RealTableName = '[none]') or (ColumnInfo.RealTableName = '[ambiguous]') or (ColumnInfo.RealTableName = '[unknown]')) then
          begin
            // Insert Table attribute
            AttributesList.Add(Format('Table(''%s'')', [ColumnInfo.RealTableName]));
          end;

          if ColumnInfo.IsPKColumn then
          begin
            AttributesList.Add('PrimaryKey');
          end;

          if not ColumnInfo.ReferencedTableColumn.IsEmpty and (ColumnInfo.ReferencedTableColumn <> '[none]') then
          begin
            AttributesList.Add(Format('RefColumn(''%s'')', [ColumnInfo.ReferencedTableColumn]));
          end;

          // Combine attributes
          if AttributesList.Count > 0 then
            AttrsLine := Format('    [%s]', [String.Join(', ', AttributesList.ToArray)])
          else
            AttrsLine := '';

          // Add field declaration
          if AttrsLine <> '' then
            ResultList.Add(Format('%s %s: %s;', [AttrsLine, FieldName, NullableDelphiType]))
          else
            ResultList.Add(Format('    %s: %s;', [FieldName, NullableDelphiType]));
        finally
          AttributesList.Free;
        end;
      end;

      // Generate published property declarations
      ResultList.Add('  published');
      PropIndex := 0;
      for i := 0 to FieldsList.Count - 1 do
      begin
        ColumnInfo := FieldsList[i];

        if not GetDelphiTypeMapping(ColumnInfo.DataType, NullableDelphiType, WriteMethod) then
        begin
          // Handle unsupported type if necessary
        end;

        // Use the sanitized FieldName (without '_')
        if ColumnInfo.QueryColumnAlias <> '' then
          FieldName := ColumnInfo.QueryColumnAlias
        else
          FieldName := ColumnInfo.ReferencedTableColumn;
        FieldName := CreateValidIdentifier(FieldName);

        // PropertyName is same as FieldName
        PropertyName := FieldName;

        // FieldName with '_'
        FieldName := '_' + FieldName;

        // Add property declaration
        ResultList.Add(Format('    property %s: %s index %d read %s write %s;', [PropertyName, NullableDelphiType, PropIndex, FieldName, WriteMethod]));

        Inc(PropIndex);
      end;

      ResultList.Add('  end;');
      ResultList.Add('');
    finally
      Parser.Free;
    end;

    Result := ResultList.Text;

  finally
    ResultList.Free;
  end;
end;

end.

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

unit formgerenc_Classes;

{$TYPEINFO ON}

interface

uses
  orm_utils, pixel_classes, ORM_CustomAttributes, System.Classes;

type
  TEmployeeProject = class(TQryRecInfo)
  private
    [Table('employees'), PrimaryKey, RefColumn('emp_id')]
    [ReadOnlyCol]
    [GridColumnDisplay(0, 'ID', 80)]  // Column 0, Caption "ID", Width 80
    _EmployeeID: TNullable<Integer>;

    [Table('employees'), PrimaryKey, RefColumn('dept_id'), ReadOnlyCol]
    _DepartmentID: TNullable<Integer>;

    [Table('employees'), RefColumn('emp_name')]
    [GridColumnDisplay(1, 'Employee Name', 200, taCenter)]  // With explicit alignment
    _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)]
    [GridColumnDisplay(2, 'Budget', 120)]  // Will use default right alignment for money
    _ProjectBudget: TNullable<Currency>;

    [Table('projects'), RefColumn('proj_status')]
    [EnumValues('active,inactive,suspended')]
    _ProjectStatus: TNullable<String>;

    [Table('employees')]
    [EnumValues('X,N,Q')]
    [Translation('X=Cancelled,N=Normal,Q=Blocked')]
    _EmployeeStatus: TNullable<string>;

    [FmtProp(tiMoney)]
    _BudgetLimit: Currency;

    _Age: Integer;
    _Older: Boolean;

    [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 SetInfoNullableInteger;
    property DepartmentID: TNullable<Integer> index 1 read _DepartmentID write SetInfoNullableInteger;
    property EmployeeName: TNullable<String> index 2 read _EmployeeName write SetInfoNullableString;
    property ProjectID: TNullable<Integer> index 3 read _ProjectID write SetInfoNullableInteger;
    property ProjectName: TNullable<String> index 4 read _ProjectName write SetInfoNullableString;
    property ProjectBudget: TNullable<Currency> index 5 read _ProjectBudget write SetInfoNullableCurrency;
    property BudgetLimit: Currency index 6 read _BudgetLimit write SetInfoCurrency;
    property Age: Integer index 7 read _Age write SetInfoInteger;
    property Older: Boolean index 8 read _Older write SetInfoBoolean;
    property ProjectDate: TNullable<TDateTime> index 9 read _ProjectDate write SetInfoNullableDateTime;
    property ProjectStartMoment: TNullable<TDateTime> index 10 read _ProjectStartMoment write SetInfoNullableDateTime;
    property ProjectStatus: TNullable<String> index 11 read _ProjectStatus write SetInfoNullableString;
    property EmployeeStatus: TNullable<String> index 12 read _EmployeeStatus write SetInfoNullableString;
  end;

implementation

end.

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

unit ORM_CustomAttributes;

{$TYPEINFO ON}

interface

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

type
  TORMFormatType = (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: TORMFormatType;
  public
    constructor Create(AFormatType: TORMFormatType);
    property FormatType: TORMFormatType read FFormatType;
  end;

  /// <summary>
  /// Attribute to specify the column index of a property in a TStringGrid.
  /// </summary>
  GridColumnAttribute = class(TCustomAttribute)
  private
    FColumnIndex: Integer;
  public
    constructor Create(AColumnIndex: Integer);
    property ColumnIndex: Integer read FColumnIndex;
  end;

  /// <summary>
  /// Attribute to specify the TComponent a property is mapped to.
  /// </summary>
  ComponentMappingAttribute = class(TCustomAttribute)
  private
    FComponentName: string;
  public
    constructor Create(const AComponentName: string);
    property ComponentName: string read FComponentName;
  end;

  /// <summary>
  /// Helper class to manage enum values
  /// </summary>
  TEnumValues = class
  private
    FValues: TArray<string>;
  public
    constructor Create(const AValuesStr: string);
    function Contains(const Value: string): Boolean;
    function ToArray: TArray<string>;
    property Values: TArray<string> read FValues;
  end;

  /// <summary>
  /// Attribute to specify allowed enum values for a field
  /// </summary>
  EnumValuesAttribute = class(TCustomAttribute)
  private
    FEnumValues: TEnumValues;
  public
    constructor Create(const AValues: string);
    destructor Destroy; override;
    function IsValidValue(const Value: string): Boolean;
    function GetValues: TArray<string>;
    property EnumValues: TEnumValues read FEnumValues;
  end;

  /// <summary>
  /// Attribute to mark a field as read-only in grids and UI
  /// </summary>
  ReadOnlyColAttribute = class(TCustomAttribute)
  public
    constructor Create;
  end;

type
  TTranslationPair = record
    StoredValue: string;
    DisplayValue: string;
  end;

  /// <summary>
  /// Helper class to manage value translations
  /// </summary>
  TTranslationValues = class
  private
    FPairs: TArray<TTranslationPair>;
  public
    constructor Create(const APairsStr: string);
    function GetDisplayValue(const StoredValue: string): string;
    function GetStoredValue(const DisplayValue: string): string;
    function HasTranslation(const Value: string; IsDisplay: Boolean = True): Boolean;
    function GetAllDisplayValues: TArray<string>;
    function GetAllStoredValues: TArray<string>;
  end;

  /// <summary>
  /// Attribute to specify translations between stored and display values
  /// Format: "stored1=display1,stored2=display2,..."
  /// </summary>
  TranslationAttribute = class(TCustomAttribute)
  private
    FTranslations: TTranslationValues;
  public
    constructor Create(const ATranslations: string);
    destructor Destroy; override;
    function GetDisplayValue(const StoredValue: string): string;
    function GetStoredValue(const DisplayValue: string): string;
    function HasDisplayValue(const Value: string): Boolean;
    function HasStoredValue(const Value: string): Boolean;
    function GetAllDisplayValues: TArray<string>;
    function GetAllStoredValues: TArray<string>;
  end;

type
  /// <summary>
  /// Defines grid column display properties for a property
  /// </summary>
  GridColumnDisplayAttribute = class(TCustomAttribute)
  private
    FColumnIndex: Integer;
    FCaption: string;
    FWidth: Integer;
    FAlignment: TAlignment;
    FHasAlignment: Boolean;
  public
    constructor Create(AColumnIndex: Integer); overload;
    constructor Create(AColumnIndex: Integer; const ACaption: string); overload;
    constructor Create(AColumnIndex: Integer; const ACaption: string; AWidth: Integer); overload;
    constructor Create(AColumnIndex: Integer; const ACaption: string; AWidth: Integer; AAlignment: TAlignment); overload;

    property ColumnIndex: Integer read FColumnIndex;
    property Caption: string read FCaption;
    property Width: Integer read FWidth;
    property Alignment: TAlignment read FAlignment;
    property HasAlignment: Boolean read FHasAlignment;
  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: TORMFormatType);
begin
  inherited Create;
  FFormatType := AFormatType;
end;

{ GridColumnAttribute }

constructor GridColumnAttribute.Create(AColumnIndex: Integer);
begin
  inherited Create;
  FColumnIndex := AColumnIndex;
end;

{ ComponentMappingAttribute }

constructor ComponentMappingAttribute.Create(const AComponentName: string);
begin
  inherited Create;
  FComponentName := AComponentName;
end;

{ EnumValuesAttribute }

constructor EnumValuesAttribute.Create(const AValues: string);
begin
  inherited Create;
  FEnumValues := TEnumValues.Create(AValues);
end;

destructor EnumValuesAttribute.Destroy;
begin
  FEnumValues.Free;
  inherited;
end;

function EnumValuesAttribute.IsValidValue(const Value: string): Boolean;
begin
  Result := FEnumValues.Contains(Value);
end;

function EnumValuesAttribute.GetValues: TArray<string>;
begin
  Result := FEnumValues.ToArray;
end;

{ TEnumValues }

constructor TEnumValues.Create(const AValuesStr: string);
begin
  inherited Create;
  // Split the comma-separated string and trim each value
  FValues := AValuesStr.Split([',']);
  for var i := 0 to High(FValues) do
    FValues[i] := FValues[i].Trim;
end;

function TEnumValues.Contains(const Value: string): Boolean;
begin
  for var EnumValue in FValues do
    if SameText(EnumValue, Value) then
      Exit(True);
  Result := False;
end;

function TEnumValues.ToArray: TArray<string>;
begin
  Result := Copy(FValues);
end;

{ ReadOnlyColAttribute }

constructor ReadOnlyColAttribute.Create;
begin
  inherited Create;
end;

constructor TTranslationValues.Create(const APairsStr: string);
var
  Pairs: TArray<string>;
  Pair: string;
  SplitPair: TArray<string>;
begin
  inherited Create;
  Pairs := APairsStr.Split([',']);
  SetLength(FPairs, Length(Pairs));

  for var i := 0 to High(Pairs) do
  begin
    Pair := Pairs[i].Trim;
    SplitPair := Pair.Split(['=']);
    if Length(SplitPair) = 2 then
    begin
      FPairs[i].StoredValue := SplitPair[0].Trim;
      FPairs[i].DisplayValue := SplitPair[1].Trim;
    end;
  end;
end;

function TTranslationValues.GetDisplayValue(const StoredValue: string): string;
begin
  for var Pair in FPairs do
    if SameText(Pair.StoredValue, StoredValue) then
      Exit(Pair.DisplayValue);
  Result := StoredValue; // Return original if no translation found
end;

function TTranslationValues.GetStoredValue(const DisplayValue: string): string;
begin
  for var Pair in FPairs do
    if SameText(Pair.DisplayValue, DisplayValue) then
      Exit(Pair.StoredValue);
  Result := DisplayValue; // Return original if no translation found
end;

function TTranslationValues.HasTranslation(const Value: string; IsDisplay: Boolean): Boolean;
begin
  for var Pair in FPairs do
    if IsDisplay then
    begin
      if SameText(Pair.DisplayValue, Value) then
        Exit(True);
    end
    else
    begin
      if SameText(Pair.StoredValue, Value) then
        Exit(True);
    end;
  Result := False;
end;

function TTranslationValues.GetAllDisplayValues: TArray<string>;
begin
  SetLength(Result, Length(FPairs));
  for var i := 0 to High(FPairs) do
    Result[i] := FPairs[i].DisplayValue;
end;

function TTranslationValues.GetAllStoredValues: TArray<string>;
begin
  SetLength(Result, Length(FPairs));
  for var i := 0 to High(FPairs) do
    Result[i] := FPairs[i].StoredValue;
end;

{ TranslationAttribute }

constructor TranslationAttribute.Create(const ATranslations: string);
begin
  inherited Create;
  FTranslations := TTranslationValues.Create(ATranslations);
end;

destructor TranslationAttribute.Destroy;
begin
  FTranslations.Free;
  inherited;
end;

function TranslationAttribute.GetDisplayValue(const StoredValue: string): string;
begin
  Result := FTranslations.GetDisplayValue(StoredValue);
end;

function TranslationAttribute.GetStoredValue(const DisplayValue: string): string;
begin
  Result := FTranslations.GetStoredValue(DisplayValue);
end;

function TranslationAttribute.HasDisplayValue(const Value: string): Boolean;
begin
  Result := FTranslations.HasTranslation(Value, True);
end;

function TranslationAttribute.HasStoredValue(const Value: string): Boolean;
begin
  Result := FTranslations.HasTranslation(Value, False);
end;

function TranslationAttribute.GetAllDisplayValues: TArray<string>;
begin
  Result := FTranslations.GetAllDisplayValues;
end;

function TranslationAttribute.GetAllStoredValues: TArray<string>;
begin
  Result := FTranslations.GetAllStoredValues;
end;

{ GridColumnDisplayAttribute }

constructor GridColumnDisplayAttribute.Create(AColumnIndex: Integer);
begin
  inherited Create;
  FColumnIndex := AColumnIndex;
  FCaption := '';
  FWidth := 0;
  FHasAlignment := False;
end;

constructor GridColumnDisplayAttribute.Create(AColumnIndex: Integer; const ACaption: string);
begin
  Create(AColumnIndex);
  FCaption := ACaption;
end;

constructor GridColumnDisplayAttribute.Create(AColumnIndex: Integer; const ACaption: string;
  AWidth: Integer);
begin
  Create(AColumnIndex, ACaption);
  FWidth := AWidth;
end;

constructor GridColumnDisplayAttribute.Create(AColumnIndex: Integer; const ACaption: string;
  AWidth: Integer; AAlignment: TAlignment);
begin
  Create(AColumnIndex, ACaption, AWidth);
  FAlignment := AAlignment;
  FHasAlignment := True;
end;

end.

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

ehance ORM_GenerateDelphiClassFromQuery to use the full capabilities os the Custom Attributes