From 67ac5107ae702e64c0b678607ac903240d3f0cac Mon Sep 17 00:00:00 2001 From: Stephane Wierzbicki Date: Tue, 26 May 2026 20:41:57 +0200 Subject: [PATCH] Added an option to select the default conversion for non-native Pascal types (variant, integer, string). The variant type is selected by default to maintain compatibility with previous versions of DataModeler. --- dm/Source/Aurelius/Aurelius.ExportForm.dfm | 105 ++++++++++++------ dm/Source/Aurelius/Aurelius.ExportForm.pas | 8 ++ .../Aurelius.SourceGenerator.Options.Xml.pas | 15 +++ .../Aurelius/Aurelius.SourceGenerator.pas | 9 +- 4 files changed, 105 insertions(+), 32 deletions(-) diff --git a/dm/Source/Aurelius/Aurelius.ExportForm.dfm b/dm/Source/Aurelius/Aurelius.ExportForm.dfm index 15f6413..0cf49d4 100644 --- a/dm/Source/Aurelius/Aurelius.ExportForm.dfm +++ b/dm/Source/Aurelius/Aurelius.ExportForm.dfm @@ -64,6 +64,7 @@ object fmAureliusExport: TfmAureliusExport 0000FF0BBB00000F0000FFF000FFFFFF0000} ReadOnly = False BrowseDialogText = 'Select Directory' + ExplicitWidth = 708 end object PageControl1: TPageControl Left = 8 @@ -74,6 +75,8 @@ object fmAureliusExport: TfmAureliusExport Anchors = [akLeft, akTop, akRight, akBottom] TabOrder = 1 OnChange = PageControl1Change + ExplicitWidth = 708 + ExplicitHeight = 412 object tsGeneral: TTabSheet Caption = 'General Settings' ImageIndex = 2 @@ -92,7 +95,7 @@ object fmAureliusExport: TfmAureliusExport Color = clWindow Version = '2.0.0.9' Visible = True - ButtonWidth = 17 + ButtonWidth = 21 DisabledBorder = False Style = csDropDownList EmptyTextStyle = [] @@ -185,7 +188,7 @@ object fmAureliusExport: TfmAureliusExport Color = clWindow Version = '2.0.0.9' Visible = True - ButtonWidth = 17 + ButtonWidth = 21 DisabledBorder = False Style = csDropDownList EmptyTextStyle = [] @@ -276,7 +279,7 @@ object fmAureliusExport: TfmAureliusExport Color = clWindow Version = '2.0.0.9' Visible = True - ButtonWidth = 17 + ButtonWidth = 21 DisabledBorder = False Style = csDropDownList EmptyTextStyle = [] @@ -347,7 +350,7 @@ object fmAureliusExport: TfmAureliusExport end object GroupBox4: TGroupBox Left = 0 - Top = 299 + Top = 300 Width = 293 Height = 81 Caption = 'Many Valued Association Naming' @@ -360,7 +363,7 @@ object fmAureliusExport: TfmAureliusExport Color = clWindow Version = '2.0.0.9' Visible = True - ButtonWidth = 17 + ButtonWidth = 21 DisabledBorder = False Style = csDropDownList EmptyTextStyle = [] @@ -446,8 +449,8 @@ object fmAureliusExport: TfmAureliusExport end end object GroupBox5: TGroupBox - Left = 300 - Top = 141 + Left = 299 + Top = 140 Width = 390 Height = 239 Caption = 'Defaults' @@ -460,7 +463,7 @@ object fmAureliusExport: TfmAureliusExport Color = clWindow Version = '2.0.0.9' Visible = True - ButtonWidth = 17 + ButtonWidth = 21 DisabledBorder = False Style = csDropDownList EmptyTextStyle = [] @@ -489,7 +492,7 @@ object fmAureliusExport: TfmAureliusExport Color = clWindow Version = '2.0.0.9' Visible = True - ButtonWidth = 17 + ButtonWidth = 21 DisabledBorder = False Style = csDropDownList EmptyTextStyle = [] @@ -518,7 +521,7 @@ object fmAureliusExport: TfmAureliusExport Color = clWindow Version = '2.0.0.9' Visible = True - ButtonWidth = 17 + ButtonWidth = 21 DisabledBorder = False Style = csDropDownList EmptyTextStyle = [] @@ -605,7 +608,7 @@ object fmAureliusExport: TfmAureliusExport Color = clWindow Version = '2.0.0.9' Visible = True - ButtonWidth = 17 + ButtonWidth = 21 DisabledBorder = False Style = csDropDownList EmptyTextStyle = [] @@ -635,7 +638,7 @@ object fmAureliusExport: TfmAureliusExport Color = clWindow Version = '2.0.0.9' Visible = True - ButtonWidth = 17 + ButtonWidth = 21 DisabledBorder = False Style = csDropDownList EmptyTextStyle = [] @@ -657,6 +660,36 @@ object fmAureliusExport: TfmAureliusExport TabOrder = 1 OnChange = SaveProperty end + object cbDefaultNonNativePascalTypeConvertion: TAdvComboBox + Left = 201 + Top = 168 + Width = 160 + Height = 21 + Color = clWindow + Version = '2.0.0.9' + Visible = True + ButtonWidth = 21 + DisabledBorder = False + Style = csDropDownList + EmptyTextStyle = [] + DropWidth = 0 + Enabled = True + ItemIndex = -1 + Items.Strings = ( + 'Variant' + 'String' + 'Integer') + LabelCaption = 'Non Native Pascal type Convertion' + LabelPosition = lpTopLeft + LabelAlwaysEnabled = True + LabelFont.Charset = DEFAULT_CHARSET + LabelFont.Color = clWindowText + LabelFont.Height = -11 + LabelFont.Name = 'Tahoma' + LabelFont.Style = [] + TabOrder = 7 + OnChange = SaveProperty + end end object edMainUnitName: TAdvEdit Left = 79 @@ -915,6 +948,7 @@ object fmAureliusExport: TfmAureliusExport PrintSettings.FooterFont.Name = 'Tahoma' PrintSettings.FooterFont.Style = [] PrintSettings.PageNumSep = '/' + ScrollWidth = 21 SearchFooter.FindNextCaption = 'Find &next' SearchFooter.FindPrevCaption = 'Find &previous' SearchFooter.Font.Charset = DEFAULT_CHARSET @@ -1152,6 +1186,7 @@ object fmAureliusExport: TfmAureliusExport PrintSettings.FooterFont.Name = 'Tahoma' PrintSettings.FooterFont.Style = [] PrintSettings.PageNumSep = '/' + ScrollWidth = 21 SearchFooter.FindNextCaption = 'Find &next' SearchFooter.FindPrevCaption = 'Find &previous' SearchFooter.Font.Charset = DEFAULT_CHARSET @@ -1323,7 +1358,7 @@ object fmAureliusExport: TfmAureliusExport Color = clWindow Version = '2.0.0.9' Visible = True - ButtonWidth = 17 + ButtonWidth = 21 DisabledBorder = False EmptyTextStyle = [] DropWidth = 0 @@ -1455,6 +1490,7 @@ object fmAureliusExport: TfmAureliusExport PrintSettings.FooterFont.Name = 'Tahoma' PrintSettings.FooterFont.Style = [] PrintSettings.PageNumSep = '/' + ScrollWidth = 21 SearchFooter.FindNextCaption = 'Find &next' SearchFooter.FindPrevCaption = 'Find &previous' SearchFooter.Font.Charset = DEFAULT_CHARSET @@ -1626,7 +1662,7 @@ object fmAureliusExport: TfmAureliusExport Color = clWindow Version = '2.0.0.9' Visible = True - ButtonWidth = 17 + ButtonWidth = 21 DisabledBorder = False Style = csDropDownList EmptyTextStyle = [] @@ -1656,7 +1692,7 @@ object fmAureliusExport: TfmAureliusExport Color = clWindow Version = '2.0.0.9' Visible = True - ButtonWidth = 17 + ButtonWidth = 21 DisabledBorder = False Style = csDropDownList EmptyTextStyle = [] @@ -1686,7 +1722,7 @@ object fmAureliusExport: TfmAureliusExport Color = clWindow Version = '2.0.0.9' Visible = True - ButtonWidth = 17 + ButtonWidth = 21 DisabledBorder = False Style = csDropDownList EmptyTextStyle = [] @@ -1815,6 +1851,7 @@ object fmAureliusExport: TfmAureliusExport PrintSettings.FooterFont.Name = 'Tahoma' PrintSettings.FooterFont.Style = [] PrintSettings.PageNumSep = '/' + ScrollWidth = 21 SearchFooter.FindNextCaption = 'Find &next' SearchFooter.FindPrevCaption = 'Find &previous' SearchFooter.Font.Charset = DEFAULT_CHARSET @@ -1986,7 +2023,7 @@ object fmAureliusExport: TfmAureliusExport Color = clWindow Version = '2.0.0.9' Visible = True - ButtonWidth = 17 + ButtonWidth = 21 DisabledBorder = False Style = csDropDownList EmptyTextStyle = [] @@ -2058,7 +2095,7 @@ object fmAureliusExport: TfmAureliusExport Color = clWindow Version = '2.0.0.9' Visible = True - ButtonWidth = 17 + ButtonWidth = 21 DisabledBorder = False EmptyTextStyle = [] DropWidth = 0 @@ -2223,6 +2260,7 @@ object fmAureliusExport: TfmAureliusExport AutoCompletion.StartToken = '(.' AutoCorrect.Active = True AutoHintParameterPosition = hpBelowCode + BkColor = clWindow BookmarkGlyph.Data = { 36050000424D3605000000000000360400002800000010000000100000000100 0800000000000001000000000000000000000001000000000000000000000000 @@ -2266,7 +2304,6 @@ object fmAureliusExport: TfmAureliusExport BFBFBFBFBFB72525FDFD9A9ABFBFBFBFBFB7BFBFB7B72525FDFDFD25BFBFBFBF BFBFBFBFBFB72525FDFD9A9ABFBFBFBFBFBFBFBFBFB725FDFDFDFD2525252525 25252525252525FDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFD} - BorderColor = 15987699 BorderStyle = bsSingle BreakpointColor = 16762823 BreakpointTextColor = clBlack @@ -2281,9 +2318,8 @@ object fmAureliusExport: TfmAureliusExport Gutter.Font.Height = -13 Gutter.Font.Name = 'Courier New' Gutter.Font.Style = [] - Gutter.BorderColor = 15987699 - Gutter.GutterColor = clWhite - Gutter.GutterColorTo = clNone + Gutter.GutterColorTo = clBtnFace + Gutter.LineNumberTextColor = clWindowText Font.Charset = DEFAULT_CHARSET Font.Color = clBlack Font.Height = -13 @@ -2304,7 +2340,7 @@ object fmAureliusExport: TfmAureliusExport PrintOptions.PrintLineNumbers = False RightMarginColor = 14869218 ScrollHint = False - SelColor = clBlack + SelColor = clHighlightText SelBkColor = clHighlight ShowRightMargin = True SmartTabs = False @@ -2352,6 +2388,8 @@ object fmAureliusExport: TfmAureliusExport ModalResult = 2 NumGlyphs = 2 TabOrder = 4 + ExplicitLeft = 636 + ExplicitTop = 507 end object btOk: TBitBtn Left = 552 @@ -2363,6 +2401,8 @@ object fmAureliusExport: TfmAureliusExport NumGlyphs = 2 TabOrder = 3 OnClick = btOkClick + ExplicitLeft = 550 + ExplicitTop = 507 end object Panel3: TPanel Left = 0 @@ -2373,6 +2413,7 @@ object fmAureliusExport: TfmAureliusExport BevelOuter = bvNone Color = clWhite TabOrder = 5 + ExplicitWidth = 724 object Shape1: TShape Left = 0 Top = 37 @@ -2390,6 +2431,7 @@ object fmAureliusExport: TfmAureliusExport Align = alClient BevelOuter = bvNone TabOrder = 0 + ExplicitWidth = 724 object Image1: TImage Left = 2 Top = 3 @@ -2478,6 +2520,7 @@ object fmAureliusExport: TfmAureliusExport NumGlyphs = 2 TabOrder = 2 OnClick = btSaveWithoutGeneratingClick + ExplicitTop = 507 end object FolderDialog1: TFolderDialog Options = [fdoNewDialogStyle] @@ -2531,8 +2574,8 @@ object fmAureliusExport: TfmAureliusExport FileExtBasicUnit = '.bsc' AutoStyler = True ProjectExt = '.ssproj' - Left = 256 - Top = 232 + Left = 528 + Top = 96 end object PopupMenu1: TPopupMenu Left = 392 @@ -2808,19 +2851,19 @@ object fmAureliusExport: TfmAureliusExport RegionType = rtClosed ShowComments = False end> - Left = 360 - Top = 232 + Left = 624 + Top = 96 end object ScrMemoFindDialog1: TScrMemoFindDialog NotFoundMessage = 'Finished searching the document. The search item was not found.' AdvMemo = mmScript Options = [frDown] - Left = 292 - Top = 297 + Left = 524 + Top = 57 end object ActionList1: TActionList - Left = 480 - Top = 208 + Left = 576 + Top = 96 object acMemoFind: TAction Caption = 'Find' ShortCut = 16454 diff --git a/dm/Source/Aurelius/Aurelius.ExportForm.pas b/dm/Source/Aurelius/Aurelius.ExportForm.pas index 1bb9800..9a61778 100644 --- a/dm/Source/Aurelius/Aurelius.ExportForm.pas +++ b/dm/Source/Aurelius/Aurelius.ExportForm.pas @@ -119,6 +119,7 @@ TfmAureliusExport = class(TForm) acMemoFind: TAction; Button2: TButton; cbLegacyDictionary: TCheckBox; + cbDefaultNonNativePascalTypeConvertion: TAdvComboBox; procedure grTablesClick(Sender: TObject); procedure grFieldsClick(Sender: TObject); procedure grAssociationsClick(Sender: TObject); @@ -194,6 +195,7 @@ TfmAureliusExport = class(TForm) function SelectedManyValuedMapping: TAssociationMapping; function SelectedManyValued: TGDAORelationship; + procedure SetMetadata(const Value: TAppMetaData); procedure ToggleSearchFooter(AGrid: TAdvStringGrid; ASearchColumn: integer); procedure GoToSequenceControl(ATable: TGDAOTable); @@ -670,6 +672,9 @@ procedure TfmAureliusExport.SaveProperty(Sender: TObject); if (Sender = cbDefaultOneToOneMapping) then FOptions.DefaultOneToOneMapping := TOneToOneMapping(cbDefaultOneToOneMapping.ItemIndex + 1) else + if (Sender = cbDefaultNonNativePascalTypeConvertion) then + FOptions.DefaultNonNativePascalTypeConvertion := TNonNativePascalTypeConvertion(cbDefaultNonNativePascalTypeConvertion.ItemIndex + 1) + else if (Sender = cbCheckSequences) then FOptions.CheckSequencesMode := TCheckSequencesMode(cbCheckSequences.ItemIndex) else @@ -1600,6 +1605,9 @@ procedure TfmAureliusExport.LoadProperty(Sender: TObject); if Sender = cbDefaultOneToOneMapping then cbDefaultOneToOneMapping.ItemIndex := Ord(FOptions.DefaultOneToOneMapping) - 1 else + if (Sender = cbDefaultNonNativePascalTypeConvertion) then + cbDefaultNonNativePascalTypeConvertion.ItemIndex := Ord(FOptions.DefaultNonNativePascalTypeConvertion) + else if Sender = cbCheckSequences then cbCheckSequences.ItemIndex := Ord(FOptions.CheckSequencesMode) else diff --git a/dm/Source/Aurelius/Aurelius.SourceGenerator.Options.Xml.pas b/dm/Source/Aurelius/Aurelius.SourceGenerator.Options.Xml.pas index e35135f..31c658c 100644 --- a/dm/Source/Aurelius/Aurelius.SourceGenerator.Options.Xml.pas +++ b/dm/Source/Aurelius/Aurelius.SourceGenerator.Options.Xml.pas @@ -124,6 +124,14 @@ function TSourceGeneratorOptionsXmlWriter.GetXml: string; WriteString(mappingsNode, 'MainUnitName', FOptions.MainUnitName); WriteString(mappingsNode, 'DictionaryName', FOptions.DictionaryName); WriteString(mappingsNode, 'DictionaryUnitName', FOptions.DictionaryUnitName); + case FOptions.DefaultNonNativePascalTypeConvertion of + nnptVariant: WriteString(mappingsNode,'DefaultNonNativePascalTypeConvertion', 'Variant'); + nnptString: WriteString(mappingsNode,'DefaultNonNativePascalTypeConvertion', 'String'); + nnptInteger: WriteString(mappingsNode,'DefaultNonNativePascalTypeConvertion', 'Integer'); + else + // DEFAULT + // nnptVariant: + end; WriteString(mappingsNode, 'Script', FOptions.Script); if FOptions.OmitDictionary then mappingsNode.Attributes['OmitDictionary'] := 'true'; @@ -371,6 +379,13 @@ procedure TSourceGeneratorOptionsXmlReader.Load(Xml: string); FOptions.OutputDir := ReadString(mappingsNode, 'OutputDir', ''); FOptions.MainUnitName := ReadString(mappingsNode, 'MainUnitName', 'UnitName'); FOptions.DictionaryName := ReadString(mappingsNode, 'DictionaryName', 'Dic'); + if LowerCase(ReadString(mappingsNode, 'DefaultNonNativePascalTypeConvertion', '')) = 'string' then + FOptions.DefaultNonNativePascalTypeConvertion := nnptString + else + if LowerCase(ReadString(mappingsNode, 'DefaultNonNativePascalTypeConvertion', '')) = 'integer' then + FOptions.DefaultNonNativePascalTypeConvertion := nnptInteger + else + FOptions.DefaultNonNativePascalTypeConvertion := nnptVariant; FOptions.DictionaryUnitName := ReadString(mappingsNode, 'DictionaryUnitName', ''); FOptions.Script := ReadString(mappingsNode, 'Script', ''); FOptions.DefaultAncestorClass := ReadString(mappingsNode, 'DefaultAncestorClass', ''); diff --git a/dm/Source/Aurelius/Aurelius.SourceGenerator.pas b/dm/Source/Aurelius/Aurelius.SourceGenerator.pas index aa2264e..8775821 100644 --- a/dm/Source/Aurelius/Aurelius.SourceGenerator.pas +++ b/dm/Source/Aurelius/Aurelius.SourceGenerator.pas @@ -2046,7 +2046,14 @@ function TSourceGenerator.GetPrimitiveDelphiType(AField: TGDAOField): string; result := 'TBlob'; end; naComputed: - result := 'Variant'; + case FOptions.DefaultNonNativePascalTypeConvertion of + nnptVariant: + result := 'Variant'; + nnptString: + result := 'string'; + nnptInteger: + result := 'Integer'; + end; else //naUnknown: ; ErrorFmt('Delphi type not defined for database native type %s',