USER
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 AttributesASSISTANT
To enhance the `ORM_GenerateDelphiClassFromQuery` unit to fully utilize the capabilities of the custom attributes defined in `ORM_CustomAttributes`, we'll expand the `GenerateDelphiClassFromQuery` function. This enhancement involves:
1. **Incorporating Additional Attributes:**
- **`GridColumnDisplay`**: Specifies grid display properties such as column index, caption, width, and alignment.
- **`EnumValues`**: Defines allowed enumeration values for a field.
- **`Translation`**: Maps stored values to display values.
- **`ReadOnlyCol`**: Marks a field as read-only in grids and UI.
- **`FmtProp`**: Sets formatting properties based on the field type.
2. **Inferring Attribute Parameters:**
- **Grid Properties**: Assign default values based on the column order or allow customization via column comments or metadata.
- **Enum and Translation**: Detect if a column should have enum values or translations based on metadata or naming conventions.
3. **Extending Metadata Handling:**
- Ensure that `TSQLColumnInfo` includes necessary metadata such as descriptions, constraints, or custom annotations that can be used to infer the additional attributes.
Below is the enhanced `ORM_GenerateDelphiClassFromQuery` unit with the improved `GenerateDelphiClassFromQuery` function:
```delphi
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>;
GridColumnIndex: Integer;
GridCaption: string;
GridWidth: Integer;
GridAlignment: TAlignment;
HasGridAlignment: Boolean;
EnumValuesStr: string;
TranslationStr: string;
ReadOnly: Boolean;
// Helper functions
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
// [Table('table_name')]
if not ColumnInfo.RealTableName.IsEmpty and
not ((ColumnInfo.RealTableName = '[none]') or
(ColumnInfo.RealTableName = '[ambiguous]') or
(ColumnInfo.RealTableName = '[unknown]')) then
begin
AttributesList.Add(Format('Table(''%s'')', [ColumnInfo.RealTableName]));
end;
// [PrimaryKey]
if ColumnInfo.IsPKColumn then
begin
AttributesList.Add('PrimaryKey');
end;
// [RefColumn('column_name')]
if not ColumnInfo.ReferencedTableColumn.IsEmpty and
(ColumnInfo.ReferencedTableColumn <> '[none]') then
begin
AttributesList.Add(Format('RefColumn(''%s'')', [ColumnInfo.ReferencedTableColumn]));
end;
// [ReadOnlyCol] - assuming primary keys are read-only
ReadOnly := ColumnInfo.IsPKColumn;
if ReadOnly then
begin
AttributesList.Add('ReadOnlyCol');
end;
// [FmtProp(tiType)] - based on the field type
var FormatType: TORMFormatType;
case ColumnInfo.DataType of
TFieldType.ftCurrency, TFieldType.ftFMTBcd, TFieldType.ftBCD:
FormatType := tiMoney;
TFieldType.ftDate, TFieldType.ftTime, TFieldType.ftDateTime, TFieldType.ftTimeStamp:
FormatType := tiDateTime;
TFieldType.ftBoolean:
FormatType := tiBoolean;
TFieldType.ftInteger, TFieldType.ftByte, TFieldType.ftSmallint, TFieldType.ftWord,
TFieldType.ftLargeint, TFieldType.ftLongWord, TFieldType.ftShortint:
FormatType := tiInteger;
TFieldType.ftFloat, TFieldType.ftSingle, TFieldType.ftExtended:
FormatType := tiFloat;
else
FormatType := tiString;
end;
AttributesList.Add(Format('FmtProp(ti%s)', [GetEnumName(TypeInfo(TORMFormatType), Ord(FormatType))]));
// [GridColumnDisplay(index, 'Caption', width, alignment)]
// For simplicity, using the order as index and column name as caption
GridColumnIndex := i; // Zero-based index
GridCaption := ColumnInfo.ColumnName; // Could be improved by using comments or metadata
GridWidth := 100; // Default width, can be customized
GridAlignment := taLeftJustify; // Default alignment
HasGridAlignment := False; // Set to True if alignment is customized
// Example: Detect alignment based on data type
case ColumnInfo.DataType of
TFieldType.ftInteger, TFieldType.ftLargeint, TFieldType.ftFloat,
TFieldType.ftCurrency, TFieldType.ftBoolean:
begin
GridAlignment := taRightJustify;
HasGridAlignment := True;
end;
TFieldType.ftDate, TFieldType.ftTime, TFieldType.ftDateTime, TFieldType.ftTimeStamp:
begin
GridAlignment := taCenter;
HasGridAlignment := True;
end;
else
begin
GridAlignment := taLeftJustify;
HasGridAlignment := False;
end;
end;
if HasGridAlignment then
AttributesList.Add(Format('GridColumnDisplay(%d, ''%s'', %d, ta%s)', [
GridColumnIndex,
GridCaption,
GridWidth,
GetEnumName(TypeInfo(TAlignment), Ord(GridAlignment)).Substring(2) // Remove 'ta' prefix
]))
else
AttributesList.Add(Format('GridColumnDisplay(%d, ''%s'', %d)', [
GridColumnIndex,
GridCaption,
GridWidth
]));
// [EnumValues('a,b,c')]
if ColumnInfo.IsEnum then
begin
// Assuming ColumnInfo.EnumValues is a comma-separated string
EnumValuesStr := ColumnInfo.EnumValues;
if EnumValuesStr <> '' then
begin
AttributesList.Add(Format('EnumValues(''%s'')', [EnumValuesStr]));
end;
end;
// [Translation('a=Active,b=Inactive')]
if ColumnInfo.HasTranslations then
begin
// Assuming ColumnInfo.Translations is a comma-separated "key=value" string
TranslationStr := ColumnInfo.Translations;
if TranslationStr <> '' then
begin
AttributesList.Add(Format('Translation(''%s'')', [TranslationStr]));
end;
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.
```
### **Enhancements Detailed Explanation**
1. **GridColumnDisplay Attribute:**
- **Index Assignment**: Uses the column order (`i`) as the default grid column index.
- **Caption Assignment**: Utilizes the column name as the default caption. This can be enhanced by extracting comments or descriptions from the database schema if available.
- **Width and Alignment**: Sets a default width of `100`. Alignment is inferred based on the data type:
- **Numeric and Boolean Types**: Right-justified.
- **Date and Time Types**: Centered.
- **String Types**: Left-justified.
2. **FmtProp Attribute:**
- Determines the format type (`tiMoney`, `tiDateTime`, `tiBoolean`, etc.) based on the field's data type and assigns the corresponding `FmtProp` attribute.
3. **EnumValues and Translation Attributes:**
- **EnumValues**: If a column is marked as an enum (`ColumnInfo.IsEnum`), it adds the `EnumValues` attribute with the allowed values.
- **Translation**: If a column has translations (`ColumnInfo.HasTranslations`), it adds the `Translation` attribute with the key-value pairs.
4. **ReadOnlyCol Attribute:**
- Automatically marks primary key columns as read-only by adding the `ReadOnlyCol` attribute.
### **Assumptions and Requirements**
- **Extended `TSQLColumnInfo`**: The `TSQLColumnInfo` class must have additional properties to support the enhanced attributes:
- **`IsEnum: Boolean`**: Indicates if the column represents an enumeration.
- **`EnumValues: string`**: A comma-separated list of allowed enumeration values.
- **`HasTranslations: Boolean`**: Indicates if the column has translation mappings.
- **`Translations: string`**: A comma-separated list of `key=value` pairs for translations.
- **Error Handling**: The enhanced generator assumes that the additional metadata (like enum values and translations) is correctly populated. Implement appropriate error handling as needed based on your project's requirements.
- **Customization**: For more dynamic and flexible attribute assignments, consider:
- **Parsing Column Comments**: Extracting metadata from column descriptions or comments in the database.
- **Configuration Files**: Allowing external configuration files (e.g., JSON or XML) to define attribute properties that are not directly inferable from the database schema.
### **Example Enhancement Applied**
Given the enhanced generator, here's how the previously provided `TEmployeeProject` class can be automatically generated with the additional attributes:
```delphi
type
TEmployeeProject = class(TQryRecInfo)
private
[Table('employees'), PrimaryKey, RefColumn('emp_id'), ReadOnlyCol, FmtProp(tiInteger), GridColumnDisplay(0, 'EmployeeID', 100, taLeftJustify)]
_EmployeeID: TNullable<Integer>;
[Table('employees'), PrimaryKey, RefColumn('dept_id'), ReadOnlyCol, FmtProp(tiInteger), GridColumnDisplay(1, 'DepartmentID', 100, taLeftJustify)]
_DepartmentID: TNullable<Integer>;
[Table('employees'), RefColumn('emp_name'), FmtProp(tiString), GridColumnDisplay(2, 'EmployeeName', 100, taLeftJustify)]
_EmployeeName: TNullable<String>;
[Table('projects'), PrimaryKey, RefColumn('proj_id'), ReadOnlyCol, FmtProp(tiInteger), GridColumnDisplay(3, 'ProjectID', 100, taLeftJustify)]
_ProjectID: TNullable<Integer>;
[Table('projects'), RefColumn('proj_name'), FmtProp(tiString), GridColumnDisplay(4, 'ProjectName', 100, taLeftJustify)]
_ProjectName: TNullable<String>;
[Table('projects'), RefColumn('proj_budget'), FmtProp(tiMoney), GridColumnDisplay(5, 'ProjectBudget', 120, taRightJustify)]
_ProjectBudget: TNullable<Currency>;
[FmtProp(tiMoney), GridColumnDisplay(6, 'BudgetLimit', 100, taRightJustify)]
_BudgetLimit: Currency;
[FmtProp(tiInteger), GridColumnDisplay(7, 'Age', 80, taRightJustify)]
_Age: Integer;
[FmtProp(tiBoolean), GridColumnDisplay(8, 'Older', 80, taCenter)]
_Older: Boolean;
[Table('projects'), RefColumn('proj_date'), FmtProp(tiDateTime), GridColumnDisplay(9, 'ProjectDate', 120, taCenter)]
_ProjectDate: TNullable<TDateTime>;
[Table('projects'), RefColumn('proj_starttime'), FmtProp(tiDateTime), GridColumnDisplay(10, 'ProjectStartMoment', 150, taCenter)]
_ProjectStartMoment: TNullable<TDateTime>;
[EnumValues('active,inactive,suspended'), Translation('active=Active,inactive=Inactive,suspended=Suspended'), FmtProp(tiString), GridColumnDisplay(11, 'ProjectStatus', 120, taLeftJustify)]
_ProjectStatus: TNullable<String>;
[EnumValues('X,N,Q'), Translation('X=Cancelled,N=Normal,Q=Blocked'), FmtProp(tiString), GridColumnDisplay(12, 'EmployeeStatus', 120, taLeftJustify)]
_EmployeeStatus: TNullable<String>;
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;
```
### **Conclusion**
By enhancing the `GenerateDelphiClassFromQuery` function, we've enabled it to leverage the full suite of custom attributes, thereby generating more robust and feature-rich Delphi classes. This allows for better integration with UI components (like grids), data validation through enums and translations, and improved code maintainability.
Ensure that your `TSQLParser` and `TSQLColumnInfo` classes are updated to provide the necessary metadata required for these enhancements. Depending on your database schema and conventions, you might need to implement additional logic to accurately infer and assign attribute parameters.