From 9212aecb4083e936f90aa2075ec9c4fcfd9dac8e Mon Sep 17 00:00:00 2001 From: Daniele Teti Date: Fri, 19 Aug 2022 10:50:45 +0200 Subject: [PATCH] Improved MVCEntitiesGenerator (WIP) --- sources/MVCFramework.Cache.pas | 2 - tools/entitygenerator/MainFormU.dfm | 1080 ++++++++++++++++----------- tools/entitygenerator/MainFormU.pas | 301 +++++--- tools/entitygenerator/UtilsU.pas | 5 + 4 files changed, 874 insertions(+), 514 deletions(-) diff --git a/sources/MVCFramework.Cache.pas b/sources/MVCFramework.Cache.pas index 1caeba2a..21af6493 100644 --- a/sources/MVCFramework.Cache.pas +++ b/sources/MVCFramework.Cache.pas @@ -209,8 +209,6 @@ begin end; procedure TMVCCache.RemoveItem(const AName: string); -var - lCacheItem: TMVCCacheItem; begin FMREW.DoWithWriteLock( procedure diff --git a/tools/entitygenerator/MainFormU.dfm b/tools/entitygenerator/MainFormU.dfm index a2809014..12fb985b 100644 --- a/tools/entitygenerator/MainFormU.dfm +++ b/tools/entitygenerator/MainFormU.dfm @@ -2,462 +2,579 @@ object MainForm: TMainForm Left = 0 Top = 0 Caption = '[DMVCFramework] MVCActiveRecord Entity Generator' - ClientHeight = 754 - ClientWidth = 1012 + ClientHeight = 688 + ClientWidth = 1199 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -16 Font.Name = 'Segoe UI' Font.Style = [] + Menu = MainMenu1 OnClose = FormClose OnCreate = FormCreate TextHeight = 21 - object Splitter1: TSplitter - Left = 0 - Top = 207 - Width = 1012 - Height = 3 - Cursor = crVSplit - Align = alTop - ExplicitTop = 169 - ExplicitWidth = 215 - end - object Panel1: TPanel + object pcMain: TPageControl Left = 0 Top = 0 - Width = 1012 - Height = 39 - Align = alTop - TabOrder = 0 - object Label1: TLabel - AlignWithMargins = True - Left = 350 - Top = 11 - Width = 276 - Height = 17 - Margins.Left = 10 - Margins.Top = 10 - Margins.Right = 10 - Margins.Bottom = 10 - Align = alLeft - Caption = 'Select a FireDAC Connection Definitions' - Layout = tlCenter - ExplicitHeight = 21 - end - object cboConnectionDefs: TComboBox - AlignWithMargins = True - Left = 4 - Top = 4 - Width = 333 - Height = 29 - Align = alLeft - TabOrder = 0 - OnChange = cboConnectionDefsChange - end - end - object Panel2: TPanel - Left = 0 - Top = 39 - Width = 1012 - Height = 168 - Align = alTop - Caption = 'Panel1' - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'Tahoma' - Font.Style = [] - ParentFont = False - TabOrder = 1 - object Label2: TLabel - AlignWithMargins = True - Left = 4 - Top = 4 - Width = 1004 - Height = 13 - Align = alTop - Caption = 'FireDAC connection parameters' - ExplicitWidth = 152 - end - object mmConnectionParams: TMemo - AlignWithMargins = True - Left = 4 - Top = 23 - Width = 638 - Height = 141 - Align = alClient - Font.Charset = ANSI_CHARSET - Font.Color = clWindowText - Font.Height = -13 - Font.Name = 'Consolas' - Font.Style = [] - ParentFont = False - ScrollBars = ssBoth - TabOrder = 0 - WordWrap = False - OnChange = mmConnectionParamsChange - end - object Panel6: TPanel - Left = 645 - Top = 20 - Width = 366 - Height = 147 - Align = alRight - BevelOuter = bvNone - Caption = 'Panel6' - ShowCaption = False - TabOrder = 1 - object GroupBox1: TGroupBox - AlignWithMargins = True - Left = 3 - Top = 3 - Width = 360 - Height = 141 - Align = alClient - Caption = 'Options' - Padding.Left = 5 - Padding.Top = 5 - Padding.Right = 5 - Padding.Bottom = 5 - TabOrder = 0 - object lstSchema: TListBox - AlignWithMargins = True - Left = 215 - Top = 23 - Width = 135 - Height = 108 - Align = alClient - ItemHeight = 13 - TabOrder = 0 - OnDblClick = lstSchemaDblClick - end - object lstCatalog: TListBox - AlignWithMargins = True - Left = 71 - Top = 23 - Width = 138 - Height = 108 - Align = alLeft - ItemHeight = 13 - TabOrder = 1 - OnDblClick = lstCatalogDblClick - end - object btnRefreshCatalog: TButton - AlignWithMargins = True - Left = 10 - Top = 23 - Width = 55 - Height = 108 - Align = alLeft - Caption = 'Refresh' - TabOrder = 2 - OnClick = btnRefreshCatalogClick - end - end - end - end - object Panel3: TPanel - Left = 0 - Top = 210 - Width = 1012 - Height = 544 + Width = 1199 + Height = 638 + ActivePage = tsGeneratedCode Align = alClient - Caption = 'Panel3' - TabOrder = 2 - object Panel4: TPanel - Left = 1 - Top = 1 - Width = 1010 - Height = 208 - Align = alTop - BevelOuter = bvNone - Caption = 'Panel4' - ShowCaption = False - TabOrder = 0 - DesignSize = ( - 1010 - 208) - object SpeedButton1: TSpeedButton - AlignWithMargins = True - Left = 129 - Top = 3 - Width = 133 - Height = 29 - Margins.Top = 2 - Margins.Right = 2 - Margins.Bottom = 2 - Caption = 'Select All' - OnClick = SpeedButton1Click - end - object SpeedButton2: TSpeedButton - AlignWithMargins = True - Left = 267 - Top = 3 - Width = 133 - Height = 29 - Margins.Top = 2 - Margins.Right = 2 - Margins.Bottom = 2 - Caption = 'Select None' - OnClick = SpeedButton2Click - end - object SpeedButton3: TSpeedButton - AlignWithMargins = True - Left = 405 - Top = 3 - Width = 133 - Height = 29 - Margins.Top = 2 - Margins.Right = 2 - Margins.Bottom = 2 - Caption = 'Invert Selection' - OnClick = SpeedButton3Click - end - object btnGenEntities: TButton - AlignWithMargins = True - Left = 842 - Top = 57 - Width = 161 - Height = 35 - Anchors = [akRight, akBottom] - Caption = 'Generate Entities' + TabOrder = 0 + object tsConnectionDefinition: TTabSheet + Caption = 'Connection Definition' + ImageIndex = 1 + object Panel2: TPanel + Left = 0 + Top = 89 + Width = 1191 + Height = 513 + Align = alClient + Caption = 'Panel1' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + ParentFont = False TabOrder = 0 - OnClick = btnGenEntitiesClick - end - object btnGetTables: TButton - AlignWithMargins = True - Left = 3 - Top = 3 - Width = 120 - Height = 40 - Caption = 'Get Tables' - TabOrder = 1 - OnClick = btnGetTablesClick - end - object chkGenerateMapping: TCheckBox - AlignWithMargins = True - Left = 10 - Top = 173 - Width = 997 - Height = 32 - Margins.Left = 10 - Align = alBottom - Caption = - 'Register entities in ActiveRecordMappingRegistry (needed by TMVC' + - 'ActiveRecordController)' - Checked = True - State = cbChecked - TabOrder = 2 - WordWrap = True - end - object rgNameCase: TRadioGroup - Left = 7 - Top = 49 - Width = 393 - Height = 104 - Caption = 'Class MVCNameCase' - Columns = 3 - ItemIndex = 0 - Items.Strings = ( - 'LowerCase' - 'UpperCase' - 'CamelCase' - 'PascalCase' - 'SnakeCase' - 'AsIs') - TabOrder = 3 - end - object rgFieldNameFormatting: TRadioGroup - Left = 406 - Top = 49 - Width = 389 - Height = 104 - Caption = 'Field Names Formatting' - ItemIndex = 1 - Items.Strings = ( - 'Leave field names as in database table' - 'Format field names as Pascal Case (eg FirstName)') - TabOrder = 4 - end - end - object PageControl1: TPageControl - AlignWithMargins = True - Left = 4 - Top = 212 - Width = 1004 - Height = 328 - ActivePage = TabSheet1 - Align = alClient - TabOrder = 1 - object TabSheet1: TTabSheet - Caption = 'Tables' - object DBGrid1: TDBGrid - Left = 0 - Top = 41 - Width = 996 - Height = 251 - Align = alClient - BorderStyle = bsNone - DataSource = dsrcTablesMapping - DefaultDrawing = False - TabOrder = 0 - TitleFont.Charset = DEFAULT_CHARSET - TitleFont.Color = clWindowText - TitleFont.Height = -16 - TitleFont.Name = 'Segoe UI' - TitleFont.Style = [] - OnCellClick = DBGrid1CellClick - OnDrawColumnCell = DBGrid1DrawColumnCell - Columns = < - item - ButtonStyle = cbsNone - Expanded = False - FieldName = 'GENERATE' - PickList.Strings = ( - 'yes' - 'no') - ReadOnly = True - Width = 86 - Visible = True - end - item - Expanded = False - FieldName = 'TABLE_NAME' - Width = 478 - Visible = True - end - item - Expanded = False - FieldName = 'CLASS_NAME' - Visible = True - end> - end - object Panel7: TPanel - Left = 0 - Top = 0 - Width = 996 - Height = 41 - Align = alTop - BevelOuter = bvNone - TabOrder = 1 - object btnUZ: TButton - AlignWithMargins = True - Left = 598 - Top = 3 - Width = 113 - Height = 35 - Align = alLeft - Caption = 'U..Z' - TabOrder = 0 - OnClick = btnUZClick - end - object Button1: TButton - AlignWithMargins = True - Left = 360 - Top = 3 - Width = 113 - Height = 35 - Align = alLeft - Caption = 'L..Q' - TabOrder = 1 - OnClick = Button1Click - end - object Button2: TButton - AlignWithMargins = True - Left = 241 - Top = 3 - Width = 113 - Height = 35 - Align = alLeft - Caption = 'E..K' - TabOrder = 2 - OnClick = Button2Click - end - object Button3: TButton - AlignWithMargins = True - Left = 122 - Top = 3 - Width = 113 - Height = 35 - Align = alLeft - Caption = 'C..D' - TabOrder = 3 - OnClick = Button3Click - end - object Button4: TButton - AlignWithMargins = True - Left = 479 - Top = 3 - Width = 113 - Height = 35 - Align = alLeft - Caption = 'R..T' - TabOrder = 4 - OnClick = btnSlice1Click - end - object Button5: TButton - AlignWithMargins = True - Left = 3 - Top = 3 - Width = 113 - Height = 35 - Align = alLeft - Caption = 'A..D' - TabOrder = 5 - OnClick = Button5Click - end - end - end - object TabSheet2: TTabSheet - Caption = 'Generated Code' - ImageIndex = 1 - object mmOutput: TMemo + object Label2: TLabel AlignWithMargins = True - Left = 3 - Top = 44 - Width = 990 - Height = 245 + Left = 4 + Top = 4 + Width = 1183 + Height = 13 + Align = alTop + Caption = 'FireDAC connection parameters' + ExplicitWidth = 152 + end + object mmConnectionParams: TMemo + AlignWithMargins = True + Left = 4 + Top = 23 + Width = 785 + Height = 445 Align = alClient - BevelInner = bvNone - BevelOuter = bvNone - BorderStyle = bsNone Font.Charset = ANSI_CHARSET Font.Color = clWindowText Font.Height = -13 Font.Name = 'Consolas' Font.Style = [] ParentFont = False - ReadOnly = True ScrollBars = ssBoth TabOrder = 0 WordWrap = False + OnChange = mmConnectionParamsChange end - object Panel5: TPanel - Left = 0 - Top = 0 - Width = 996 - Height = 41 - Align = alTop - Caption = 'Panel5' + object Panel6: TPanel + Left = 792 + Top = 20 + Width = 398 + Height = 451 + Align = alRight + BevelOuter = bvNone + Caption = 'Panel6' ShowCaption = False TabOrder = 1 - object btnSaveCode: TButton + object GroupBox1: TGroupBox AlignWithMargins = True - Left = 4 - Top = 4 - Width = 75 - Height = 33 - Align = alLeft - Caption = '&Save' + Left = 3 + Top = 3 + Width = 392 + Height = 445 + Align = alClient + Caption = 'Select a catalog and then the schema where your tables are' + Padding.Left = 5 + Padding.Top = 5 + Padding.Right = 5 + Padding.Bottom = 5 + TabOrder = 0 + object lstSchema: TListBox + AlignWithMargins = True + Left = 191 + Top = 50 + Width = 191 + Height = 385 + Align = alClient + ItemHeight = 13 + TabOrder = 0 + end + object lstCatalog: TListBox + AlignWithMargins = True + Left = 10 + Top = 50 + Width = 175 + Height = 385 + Align = alLeft + ItemHeight = 13 + TabOrder = 1 + OnClick = lstCatalogClick + end + object Panel11: TPanel + Left = 7 + Top = 20 + Width = 378 + Height = 27 + Align = alTop + BevelOuter = bvNone + Caption = 'Panel11' + ShowCaption = False + TabOrder = 2 + object Label4: TLabel + Left = 3 + Top = 11 + Width = 42 + Height = 13 + Caption = 'Catalogs' + end + object Label5: TLabel + Left = 184 + Top = 11 + Width = 42 + Height = 13 + Caption = 'Schemas' + end + end + end + end + object Panel9: TPanel + Left = 1 + Top = 471 + Width = 1189 + Height = 41 + Align = alBottom + BevelOuter = bvNone + Caption = 'Panel9' + ShowCaption = False + TabOrder = 2 + object btnRefreshCatalog: TButton + AlignWithMargins = True + Left = 1068 + Top = 3 + Width = 118 + Height = 35 + Action = actRefreshCatalog + Align = alRight + TabOrder = 0 + end + end + end + object Panel1: TPanel + Left = 0 + Top = 0 + Width = 1191 + Height = 89 + Align = alTop + TabOrder = 1 + object Label1: TLabel + AlignWithMargins = True + Left = 19 + Top = 12 + Width = 276 + Height = 21 + Margins.Left = 10 + Margins.Top = 10 + Margins.Right = 10 + Margins.Bottom = 10 + Caption = 'Select a FireDAC Connection Definitions' + Layout = tlCenter + end + object Label3: TLabel + AlignWithMargins = True + Left = 599 + Top = 11 + Width = 581 + Height = 67 + Margins.Left = 10 + Margins.Top = 10 + Margins.Right = 10 + Margins.Bottom = 10 + Align = alRight + Caption = + 'Please, select the FireDAC connection definition from the combo ' + + 'box on the left. Then, if available, select the catalog and the ' + + 'schema where the tables are. In the next steps entities will be ' + + 'generated from that set of tables.' + Layout = tlCenter + WordWrap = True + ExplicitLeft = 593 + ExplicitHeight = 63 + end + object cboConnectionDefs: TComboBox + AlignWithMargins = True + Left = 19 + Top = 46 + Width = 276 + Height = 29 + Style = csDropDownList + TabOrder = 0 + OnChange = cboConnectionDefsChange + end + end + end + object tsTablesMapping: TTabSheet + Caption = 'Tables Mapping' + ImageIndex = 2 + object Panel3: TPanel + Left = 0 + Top = 0 + Width = 1191 + Height = 602 + Align = alClient + Caption = 'Panel3' + TabOrder = 0 + object Panel4: TPanel + Left = 1 + Top = 1 + Width = 1189 + Height = 208 + Align = alTop + BevelOuter = bvNone + Caption = 'Panel4' + ShowCaption = False + TabOrder = 0 + DesignSize = ( + 1189 + 208) + object btnGenEntities: TButton + AlignWithMargins = True + Left = 1242 + Top = 57 + Width = 161 + Height = 35 + Anchors = [akRight, akBottom] + Caption = 'Generate Entities' + TabOrder = 0 + end + object chkGenerateMapping: TCheckBox + AlignWithMargins = True + Left = 10 + Top = 173 + Width = 1176 + Height = 32 + Margins.Left = 10 + Align = alBottom + Caption = + 'Register entities in ActiveRecordMappingRegistry (needed by TMVC' + + 'ActiveRecordController)' + Checked = True + State = cbChecked + TabOrder = 1 + WordWrap = True + end + object rgNameCase: TRadioGroup + Left = 7 + Top = 49 + Width = 393 + Height = 104 + Caption = 'Class MVCNameCase' + Columns = 3 + ItemIndex = 0 + Items.Strings = ( + 'LowerCase' + 'UpperCase' + 'CamelCase' + 'PascalCase' + 'SnakeCase' + 'AsIs') + TabOrder = 2 + end + object rgFieldNameFormatting: TRadioGroup + Left = 406 + Top = 49 + Width = 389 + Height = 104 + Caption = 'Field Names Formatting' + ItemIndex = 1 + Items.Strings = ( + 'Leave field names as in database table' + 'Format field names as Pascal Case (eg FirstName)') + TabOrder = 3 + end + end + object PageControl1: TPageControl + AlignWithMargins = True + Left = 4 + Top = 260 + Width = 1183 + Height = 338 + ActivePage = TabSheet1 + Align = alClient + TabOrder = 1 + object TabSheet1: TTabSheet + Caption = 'Tables' + object DBGrid1: TDBGrid + Left = 0 + Top = 41 + Width = 1175 + Height = 261 + Align = alClient + BorderStyle = bsNone + DataSource = dsrcTablesMapping + DefaultDrawing = False + TabOrder = 0 + TitleFont.Charset = DEFAULT_CHARSET + TitleFont.Color = clWindowText + TitleFont.Height = -16 + TitleFont.Name = 'Segoe UI' + TitleFont.Style = [] + OnCellClick = DBGrid1CellClick + OnDrawColumnCell = DBGrid1DrawColumnCell + Columns = < + item + ButtonStyle = cbsNone + Expanded = False + FieldName = 'GENERATE' + PickList.Strings = ( + 'yes' + 'no') + ReadOnly = True + Width = 86 + Visible = True + end + item + Expanded = False + FieldName = 'TABLE_NAME' + Width = 478 + Visible = True + end + item + Expanded = False + FieldName = 'CLASS_NAME' + Visible = True + end> + end + object Panel7: TPanel + Left = 0 + Top = 0 + Width = 1175 + Height = 41 + Align = alTop + BevelOuter = bvNone + TabOrder = 1 + object btnUZ: TButton + AlignWithMargins = True + Left = 598 + Top = 3 + Width = 113 + Height = 35 + Align = alLeft + Caption = 'U..Z' + TabOrder = 0 + OnClick = btnUZClick + end + object Button1: TButton + AlignWithMargins = True + Left = 360 + Top = 3 + Width = 113 + Height = 35 + Align = alLeft + Caption = 'L..Q' + TabOrder = 1 + OnClick = Button1Click + end + object Button2: TButton + AlignWithMargins = True + Left = 241 + Top = 3 + Width = 113 + Height = 35 + Align = alLeft + Caption = 'E..K' + TabOrder = 2 + OnClick = Button2Click + end + object Button3: TButton + AlignWithMargins = True + Left = 122 + Top = 3 + Width = 113 + Height = 35 + Align = alLeft + Caption = 'C..D' + TabOrder = 3 + OnClick = Button3Click + end + object Button4: TButton + AlignWithMargins = True + Left = 479 + Top = 3 + Width = 113 + Height = 35 + Align = alLeft + Caption = 'R..T' + TabOrder = 4 + OnClick = btnSlice1Click + end + object Button5: TButton + AlignWithMargins = True + Left = 3 + Top = 3 + Width = 113 + Height = 35 + Align = alLeft + Caption = 'A..D' + TabOrder = 5 + OnClick = Button5Click + end + end + end + end + object Panel10: TPanel + Left = 1 + Top = 209 + Width = 1189 + Height = 48 + Align = alTop + Caption = 'Panel10' + ShowCaption = False + TabOrder = 2 + object SpeedButton1: TSpeedButton + AlignWithMargins = True + Left = 764 + Top = 6 + Width = 133 + Height = 36 + Margins.Left = 5 + Margins.Top = 5 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alRight + Caption = 'Select All' + OnClick = SpeedButton1Click + ExplicitLeft = 129 + ExplicitTop = 3 + ExplicitHeight = 29 + end + object SpeedButton2: TSpeedButton + AlignWithMargins = True + Left = 907 + Top = 6 + Width = 133 + Height = 36 + Margins.Left = 5 + Margins.Top = 5 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alRight + Caption = 'Select None' + OnClick = SpeedButton2Click + ExplicitLeft = 267 + ExplicitTop = 3 + ExplicitHeight = 29 + end + object SpeedButton3: TSpeedButton + AlignWithMargins = True + Left = 1050 + Top = 6 + Width = 133 + Height = 36 + Margins.Left = 5 + Margins.Top = 5 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alRight + Caption = 'Invert Selection' + OnClick = SpeedButton3Click + ExplicitLeft = 405 + ExplicitTop = 3 + ExplicitHeight = 29 + end + object btnGetTables: TButton + AlignWithMargins = True + Left = 6 + Top = 6 + Width = 163 + Height = 36 + Margins.Left = 5 + Margins.Top = 5 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alLeft + Caption = 'Refresh Table List' TabOrder = 0 - OnClick = btnSaveCodeClick end end end end + object tsGeneratedCode: TTabSheet + Caption = 'Generated Code' + ImageIndex = 2 + object Panel5: TPanel + Left = 0 + Top = 0 + Width = 1191 + Height = 41 + Align = alTop + Caption = 'Panel5' + ShowCaption = False + TabOrder = 0 + object btnSaveCode: TButton + AlignWithMargins = True + Left = 4 + Top = 4 + Width = 189 + Height = 33 + Action = actSaveGeneratedCode + Align = alLeft + TabOrder = 0 + end + end + object mmOutput: TMemo + AlignWithMargins = True + Left = 3 + Top = 44 + Width = 1185 + Height = 555 + Align = alClient + BevelInner = bvNone + BevelOuter = bvNone + BorderStyle = bsNone + Font.Charset = ANSI_CHARSET + Font.Color = clWindowText + Font.Height = -13 + Font.Name = 'Consolas' + Font.Style = [] + ParentFont = False + ReadOnly = True + ScrollBars = ssBoth + TabOrder = 1 + WordWrap = False + end + end end - object FDConnection1: TFDConnection + object Panel8: TPanel + Left = 0 + Top = 638 + Width = 1199 + Height = 50 + Align = alBottom + BevelOuter = bvNone + TabOrder = 1 + object btnPrev: TButton + AlignWithMargins = True + Left = 982 + Top = 3 + Width = 104 + Height = 44 + Action = TabPreviousTab1 + Align = alRight + TabOrder = 0 + end + object btnNext: TButton + AlignWithMargins = True + Left = 1092 + Top = 3 + Width = 104 + Height = 44 + Action = TabNextTab1 + Align = alRight + TabOrder = 1 + end + end + object FDConnection: TFDConnection Params.Strings = ( 'DriverID=MSSQL') ResourceOptions.AssignedValues = [rvKeepConnection] @@ -468,11 +585,11 @@ object MainForm: TMainForm UpdateOptions.EnableUpdate = False ConnectedStoredUsage = [] LoginPrompt = False - Left = 256 - Top = 56 + Left = 480 + Top = 176 end object qry: TFDQuery - Connection = FDConnection1 + Connection = FDConnection FetchOptions.AssignedValues = [evRecsMax, evRowsetSize, evUnidirectional, evAutoFetchAll] FetchOptions.Unidirectional = True FetchOptions.RowsetSize = 1 @@ -560,7 +677,7 @@ object MainForm: TMainForm UpdateOptions.AutoCommitUpdates = True StoreDefs = True Left = 72 - Top = 592 + Top = 488 object dsTablesMappingGENERATE: TBooleanField DisplayLabel = 'Generate?' FieldName = 'GENERATE' @@ -580,7 +697,114 @@ object MainForm: TMainForm end object dsrcTablesMapping: TDataSource DataSet = dsTablesMapping - Left = 136 - Top = 592 + Left = 192 + Top = 488 + end + object ProjectFileOpenDialog: TFileOpenDialog + FavoriteLinks = <> + FileName = 'C:\DEV\dmvcframework\tools\entitygenerator' + FileTypes = < + item + DisplayName = 'DMVC Entities Generator Project' + FileMask = '*.entgen' + end> + Options = [] + Left = 280 + Top = 256 + end + object MainMenu1: TMainMenu + Left = 688 + Top = 232 + object File1: TMenuItem + Caption = '&File' + object NewProject1: TMenuItem + Action = actNewProject + end + object LoadProject1: TMenuItem + Action = actLoadProject + end + object SaveProject1: TMenuItem + Action = actSaveProject + end + object Saveprojectas1: TMenuItem + Action = actSaveProjectAs + end + object N1: TMenuItem + Caption = '-' + end + object Exit1: TMenuItem + Action = FileExit1 + end + end + end + object ActionList1: TActionList + Left = 808 + Top = 240 + object actLoadProject: TAction + Caption = 'Load Project' + OnExecute = actLoadProjectExecute + end + object actSaveProject: TAction + Caption = 'Save Project' + OnExecute = actSaveProjectExecute + end + object actSaveProjectAs: TAction + Caption = 'Save project as...' + OnExecute = actSaveProjectAsExecute + end + object FileExit1: TFileExit + Category = 'File' + Caption = 'E&xit' + Hint = 'Exit|Quits the application' + ImageIndex = 43 + end + object TabNextTab1: TNextTab + Category = 'Tab' + TabControl = pcMain + Caption = '&Next' + Enabled = False + Hint = 'Next|Go to the next tab' + AfterTabChange = TabNextTab1AfterTabChange + OnUpdate = TabNextTab1Update + end + object TabPreviousTab1: TPreviousTab + Category = 'Tab' + TabControl = pcMain + Caption = '&Previous' + Enabled = False + Hint = 'Previous|Go back to the previous tab' + end + object actSaveGeneratedCode: TAction + Caption = 'Save Generated Code' + OnExecute = actSaveGeneratedCodeExecute + OnUpdate = actSaveGeneratedCodeUpdate + end + object actGenerateCode: TAction + Caption = 'Generate Code' + OnExecute = actGenerateCodeExecute + end + object actRefreshCatalog: TAction + Caption = 'Refresh Catalog' + OnExecute = actRefreshCatalogExecute + end + object actRefreshTableList: TAction + Caption = 'Refresh Table List' + OnExecute = actRefreshTableListExecute + end + object actNewProject: TAction + Caption = 'New Project' + OnExecute = actNewProjectExecute + end + end + object FileSaveDialogProject: TFileSaveDialog + FavoriteLinks = <> + FileTypes = < + item + DisplayName = 'DMVC Entities Generator' + FileMask = '*.entgen' + end> + Options = [] + Left = 328 + Top = 360 end end diff --git a/tools/entitygenerator/MainFormU.pas b/tools/entitygenerator/MainFormU.pas index c99e6560..6e16bc14 100644 --- a/tools/entitygenerator/MainFormU.pas +++ b/tools/entitygenerator/MainFormU.pas @@ -50,33 +50,18 @@ uses FireDAC.Stan.ExprFuncs, FireDAC.Phys.SQLiteDef, FireDAC.Phys.SQLite, Vcl.DBGrids, FireDAC.Phys.SQLiteWrapper.Stat, Vcl.Buttons, - JsonDataObjects; + JsonDataObjects, System.Actions, Vcl.ActnList, Vcl.Menus, Vcl.StdActns, + Vcl.ExtActns; type TSelectionType = (stAll, stNone, stInverse); TMainForm = class(TForm) - FDConnection1: TFDConnection; - Panel1: TPanel; - Panel2: TPanel; + FDConnection: TFDConnection; qry: TFDQuery; FDPhysFBDriverLink1: TFDPhysFBDriverLink; FDGUIxWaitCursor1: TFDGUIxWaitCursor; - Splitter1: TSplitter; - mmConnectionParams: TMemo; - Label2: TLabel; FDPhysMSSQLDriverLink1: TFDPhysMSSQLDriverLink; - cboConnectionDefs: TComboBox; - Panel3: TPanel; - Panel4: TPanel; - btnGenEntities: TButton; - PageControl1: TPageControl; - TabSheet1: TTabSheet; - TabSheet2: TTabSheet; - btnGetTables: TButton; - mmOutput: TMemo; - Panel5: TPanel; - btnSaveCode: TButton; FileSaveDialog1: TFileSaveDialog; FDPhysMySQLDriverLink1: TFDPhysMySQLDriverLink; FDPhysPgDriverLink1: TFDPhysPgDriverLink; @@ -87,21 +72,27 @@ type dsTablesMapping: TFDMemTable; dsTablesMappingTABLE_NAME: TStringField; dsTablesMappingCLASS_NAME: TStringField; - DBGrid1: TDBGrid; dsrcTablesMapping: TDataSource; + dsTablesMappingGENERATE: TBooleanField; + pcMain: TPageControl; + tsConnectionDefinition: TTabSheet; + tsTablesMapping: TTabSheet; + Panel2: TPanel; + Label2: TLabel; + mmConnectionParams: TMemo; Panel6: TPanel; GroupBox1: TGroupBox; lstSchema: TListBox; lstCatalog: TListBox; - btnRefreshCatalog: TButton; - Label1: TLabel; + Panel3: TPanel; + Panel4: TPanel; + btnGenEntities: TButton; chkGenerateMapping: TCheckBox; - dsTablesMappingGENERATE: TBooleanField; - SpeedButton1: TSpeedButton; - SpeedButton2: TSpeedButton; - SpeedButton3: TSpeedButton; rgNameCase: TRadioGroup; rgFieldNameFormatting: TRadioGroup; + PageControl1: TPageControl; + TabSheet1: TTabSheet; + DBGrid1: TDBGrid; Panel7: TPanel; btnUZ: TButton; Button1: TButton; @@ -109,16 +100,53 @@ type Button3: TButton; Button4: TButton; Button5: TButton; - procedure btnGenEntitiesClick(Sender: TObject); - procedure btnGetTablesClick(Sender: TObject); - procedure btnSaveCodeClick(Sender: TObject); + Panel8: TPanel; + btnPrev: TButton; + btnNext: TButton; + ProjectFileOpenDialog: TFileOpenDialog; + MainMenu1: TMainMenu; + ActionList1: TActionList; + actLoadProject: TAction; + actSaveProject: TAction; + actSaveProjectAs: TAction; + File1: TMenuItem; + LoadProject1: TMenuItem; + SaveProject1: TMenuItem; + Saveprojectas1: TMenuItem; + FileExit1: TFileExit; + Exit1: TMenuItem; + N1: TMenuItem; + Panel1: TPanel; + Label1: TLabel; + cboConnectionDefs: TComboBox; + Panel9: TPanel; + btnRefreshCatalog: TButton; + TabNextTab1: TNextTab; + TabPreviousTab1: TPreviousTab; + tsGeneratedCode: TTabSheet; + Panel5: TPanel; + btnSaveCode: TButton; + mmOutput: TMemo; + actSaveGeneratedCode: TAction; + actGenerateCode: TAction; + actRefreshCatalog: TAction; + Panel10: TPanel; + btnGetTables: TButton; + SpeedButton1: TSpeedButton; + SpeedButton2: TSpeedButton; + SpeedButton3: TSpeedButton; + actRefreshTableList: TAction; + Label3: TLabel; + Panel11: TPanel; + Label4: TLabel; + Label5: TLabel; + FileSaveDialogProject: TFileSaveDialog; + actNewProject: TAction; + NewProject1: TMenuItem; procedure cboConnectionDefsChange(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); - procedure lstCatalogDblClick(Sender: TObject); - procedure btnRefreshCatalogClick(Sender: TObject); procedure mmConnectionParamsChange(Sender: TObject); - procedure lstSchemaDblClick(Sender: TObject); procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); procedure DBGrid1CellClick(Column: TColumn); @@ -131,16 +159,30 @@ type procedure btnSlice1Click(Sender: TObject); procedure btnUZClick(Sender: TObject); procedure Button5Click(Sender: TObject); + procedure actLoadProjectExecute(Sender: TObject); + procedure actSaveGeneratedCodeExecute(Sender: TObject); + procedure actGenerateCodeExecute(Sender: TObject); + procedure lstCatalogClick(Sender: TObject); + procedure actRefreshCatalogExecute(Sender: TObject); + procedure TabNextTab1AfterTabChange(Sender: TObject); + procedure actRefreshTableListExecute(Sender: TObject); + procedure TabNextTab1Update(Sender: TObject); + procedure actSaveProjectExecute(Sender: TObject); + procedure actSaveProjectAsExecute(Sender: TObject); + procedure actNewProjectExecute(Sender: TObject); + procedure actSaveGeneratedCodeUpdate(Sender: TObject); private fConfig: TJSONObject; fCatalog: string; + fProjectFileName: string; fSchema: string; fIntfBuff, fImplBuff, fInitializationBuff: TStringStream; FHistoryFileName: string; lTypesName: TArray; fBookmark: TArray; - procedure InitFromLastConfig; - procedure SaveLastConfig; + procedure ResetUI; + procedure LoadProjectFromFile; + procedure SaveProject; function SelectTables(const FromLetter: AnsiChar; const ToLetter: AnsiChar): Integer; procedure EmitHeaderComments; function GetClassName(const aTableName: string): string; @@ -155,8 +197,11 @@ type function GetDelphiType(FT: TFieldType): string; function GetFieldName(const Value: string): string; procedure DoSelection(const SelectionType: TSelectionType); + procedure SetProjectFileName(const Value: String); + function GetProjectFileExists: Boolean; public - { Public declarations } + property ProjectFileName: String read fProjectFileName write SetProjectFileName; + property ProjectFileExists: Boolean read GetProjectFileExists; end; var @@ -181,7 +226,7 @@ uses const INDENT = ' '; -procedure TMainForm.btnGenEntitiesClick(Sender: TObject); +procedure TMainForm.actGenerateCodeExecute(Sender: TObject); var I: Integer; lTableName: string; @@ -191,7 +236,7 @@ var lKeyFields: TStringList; lUniqueFieldNames: TArray; begin - SaveLastConfig; +// SaveProject; Log.Info('Starting entities generation', LOG_TAG); fIntfBuff.Clear; fImplBuff.Clear; @@ -216,10 +261,10 @@ begin EmitClass(lTableName, lClassName, rgNameCase.Items[rgNameCase.ItemIndex]); lKeyFields.Clear; qry.Close; - qry.SQL.Text := 'select * from ' + lTableName + ' where 1=1 limit 1'; + qry.SQL.Text := 'select * from ' + lTableName + ' where 1=0'; qry.Open; try - FDConnection1.GetKeyFieldNames(fCatalog, fSchema, lTableName, '', lKeyFields); + FDConnection.GetKeyFieldNames(fCatalog, fSchema, lTableName, '', lKeyFields); except end; lFieldNamesToInitialize := []; @@ -285,15 +330,49 @@ begin // mmOutput.Lines.SaveToFile( // mmConnectionParams.Lines.SaveToFile(FHistoryFileName); ShowMessage('Generation Completed'); + TabNextTab1.Execute; end; -procedure TMainForm.btnGetTablesClick(Sender: TObject); +procedure TMainForm.actLoadProjectExecute(Sender: TObject); +begin + ProjectFileOpenDialog.DefaultExtension := 'entgen'; + + if ProjectFileOpenDialog.Execute then + begin + ProjectFileName := ProjectFileOpenDialog.FileName; + LoadProjectFromFile; + end; +end; + +procedure TMainForm.actNewProjectExecute(Sender: TObject); +begin + ProjectFileName := DEFAULT_PROJECT_NAME; + LoadProjectFromFile; +end; + +procedure TMainForm.actRefreshCatalogExecute(Sender: TObject); +begin + FDConnection.Params.Clear; + FDConnection.Params.Text := mmConnectionParams.Text; + try + FDConnection.Open; + lstCatalog.Items.Clear; + FDConnection.GetCatalogNames('', lstCatalog.Items); + except + on E: Exception do + begin + Application.ShowException(E); + end; + end; +end; + +procedure TMainForm.actRefreshTableListExecute(Sender: TObject); var lTables: TStringList; lTable: string; lClassName: string; begin - FDConnection1.Connected := True; + FDConnection.Connected := True; lTables := TStringList.Create; try fCatalog := ''; @@ -306,7 +385,7 @@ begin begin fSchema := lstSchema.Items[lstSchema.ItemIndex]; end; - FDConnection1.GetTableNames(fCatalog, fSchema, '', lTables); + FDConnection.GetTableNames(fCatalog, fSchema, '', lTables); // FDConnection1.GetTableNames('', 'public', '', lTables); @@ -327,17 +406,7 @@ begin TabSheet1.Caption := 'Tables (' + dsTablesMapping.RecordCount.ToString + ')'; end; -procedure TMainForm.btnRefreshCatalogClick(Sender: TObject); -begin - FDConnection1.Params.Clear; - FDConnection1.Params.Text := mmConnectionParams.Text; - FDConnection1.Open; - lstCatalog.Items.Clear; - FDConnection1.GetCatalogNames('', lstCatalog.Items); - PageControl1.ActivePageIndex := 0; -end; - -procedure TMainForm.btnSaveCodeClick(Sender: TObject); +procedure TMainForm.actSaveGeneratedCodeExecute(Sender: TObject); begin FileSaveDialog1.FileName := 'EntitiesU.pas'; if FileSaveDialog1.Execute then @@ -346,6 +415,28 @@ begin end; end; +procedure TMainForm.actSaveGeneratedCodeUpdate(Sender: TObject); +begin + actSaveGeneratedCode.Enabled := mmOutput.Lines.Count > 0; +end; + +procedure TMainForm.actSaveProjectAsExecute(Sender: TObject); +begin + if FileSaveDialogProject.Execute then + begin + ProjectFileName := FileSaveDialogProject.FileName; + SaveProject; + end; +end; + +procedure TMainForm.actSaveProjectExecute(Sender: TObject); +begin + if not ProjectFileExists then + actSaveProjectAs.Execute + else + SaveProject; +end; + procedure TMainForm.btnSlice1Click(Sender: TObject); begin ShowMessage('Select ' + SelectTables('R', 'T').ToString + ' new tables'); @@ -378,12 +469,13 @@ end; procedure TMainForm.cboConnectionDefsChange(Sender: TObject); begin - FDConnection1.Close; + FDConnection.Close; FDManager.GetConnectionDefParams(cboConnectionDefs.Text, mmConnectionParams.Lines); lstCatalog.Items.Clear; lstSchema.Items.Clear; - FDConnection1.Params.Clear; - FDConnection1.Params.Text := mmConnectionParams.Text; + FDConnection.Params.Clear; + FDConnection.Params.Text := mmConnectionParams.Text; + actRefreshCatalog.Execute; end; procedure TMainForm.DBGrid1CellClick(Column: TColumn); @@ -570,7 +662,6 @@ end; procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction); begin - SaveLastConfig; fIntfBuff.Free; fImplBuff.Free; fInitializationBuff.Free; @@ -578,11 +669,8 @@ end; procedure TMainForm.FormCreate(Sender: TObject); begin + pcMain.ActivePageIndex := 0; fConfig := TJSONObject.Create; - if TFile.Exists(CONFIG_FILE) then - begin - fConfig.LoadFromFile(CONFIG_FILE); - end; fIntfBuff := TStringStream.Create; fImplBuff := TStringStream.Create; fInitializationBuff := TStringStream.Create; @@ -600,7 +688,9 @@ begin FDManager.LoadConnectionDefFile; FDManager.GetConnectionNames(cboConnectionDefs.Items); - InitFromLastConfig; + ProjectFileName := DEFAULT_PROJECT_NAME; + + // LoadProjectFromFile; end; function TMainForm.GetClassName(const aTableName: string): string; @@ -673,17 +763,12 @@ begin begin Exit('f' + Value.ToUpper); end; + Result := 'f' + Value; +end; - // Result := ''; - // Pieces := Value.ToLower.Split(['_'], TStringSplitOptions.ExcludeEmpty); - // for Piece in Pieces do - // begin - // if Piece = 'id' then - // Result := Result + 'ID' - // else - // Result := Result + UpperCase(Piece.Chars[0]) + Piece.Substring(1); - // end; - Result := 'f' + Value; // CamelCase(Value, True); +function TMainForm.GetProjectFileExists: Boolean; +begin + Result := TFile.Exists(ProjectFileName); end; function TMainForm.GetUniqueFieldNames(const Fields: TFields; const FormatAsPascalCase: Boolean): TArray; @@ -734,25 +819,33 @@ begin end; end; -procedure TMainForm.InitFromLastConfig; +procedure TMainForm.LoadProjectFromFile; var I, J: Integer; lJObj: TJSONObject; begin + ResetUI; + + if not TFile.Exists(fProjectFileName) then + begin + Exit; + end; + + fConfig.LoadFromFile(fProjectFileName); if cboConnectionDefs.Items.IndexOf(fConfig.S[cboConnectionDefs.Name]) = -1 then Exit; cboConnectionDefs.ItemIndex := cboConnectionDefs.Items.IndexOf(fConfig.S[cboConnectionDefs.Name]); cboConnectionDefsChange(self); - btnRefreshCatalogClick(self); + actRefreshCatalog.Execute; lstCatalog.Update; if fConfig.IndexOf(lstCatalog.Name) > -1 then begin lstCatalog.ItemIndex := lstCatalog.Items.IndexOf(fConfig.S[lstCatalog.Name]); - lstCatalogDblClick(self); + lstCatalogClick(self); lstSchema.ItemIndex := lstSchema.Items.IndexOf(fConfig.S[lstSchema.Name]); end; - btnGetTablesClick(self); + actRefreshTableList.Execute; rgNameCase.ItemIndex := fConfig.I[rgNameCase.Name]; rgFieldNameFormatting.ItemIndex := fConfig.I[rgFieldNameFormatting.Name]; @@ -784,25 +877,34 @@ begin dsTablesMapping.First; end; -procedure TMainForm.lstCatalogDblClick(Sender: TObject); +procedure TMainForm.lstCatalogClick(Sender: TObject); begin lstSchema.Items.Clear; - FDConnection1.GetSchemaNames(lstCatalog.Items[lstCatalog.ItemIndex], '', lstSchema.Items); -end; + FDConnection.GetSchemaNames(lstCatalog.Items[lstCatalog.ItemIndex], '', lstSchema.Items); -procedure TMainForm.lstSchemaDblClick(Sender: TObject); -begin - btnGetTablesClick(self); end; procedure TMainForm.mmConnectionParamsChange(Sender: TObject); begin - FDConnection1.Close; + FDConnection.Close; lstSchema.Clear; lstCatalog.Clear; end; -procedure TMainForm.SaveLastConfig; +procedure TMainForm.ResetUI; +begin + cboConnectionDefs.ItemIndex := -1; + mmConnectionParams.Clear; + lstCatalog.Clear; + lstSchema.Clear; + rgNameCase.ItemIndex := 0; + rgFieldNameFormatting.ItemIndex := 0; + chkGenerateMapping.Checked := False; + dsTablesMapping.EmptyDataSet; + mmOutput.Clear; +end; + +procedure TMainForm.SaveProject; var lJObj: TJSONObject; lField: TField; @@ -834,7 +936,7 @@ begin dsTablesMapping.Next; end; dsTablesMapping.First; - fConfig.SaveToFile(CONFIG_FILE, False); + fConfig.SaveToFile(fProjectFileName, False); end; function TMainForm.SelectTables(const FromLetter, ToLetter: AnsiChar): Integer; @@ -868,6 +970,12 @@ begin Result := lSelectedTables; end; +procedure TMainForm.SetProjectFileName(const Value: String); +begin + fProjectFileName := TPath.ChangeExtension(Value, '.entgen'); + Caption := 'DMVCFramework Entities Generator :: ' + fProjectFileName; +end; + procedure TMainForm.SpeedButton1Click(Sender: TObject); begin DoSelection(stAll); @@ -883,4 +991,29 @@ begin DoSelection(stInverse); end; +procedure TMainForm.TabNextTab1AfterTabChange(Sender: TObject); +begin + if pcMain.ActivePage = tsTablesMapping then + begin + actRefreshTableList.Execute; + end; + if pcMain.ActivePage = tsGeneratedCode then + begin + actGenerateCode.Execute; + end; + +end; + +procedure TMainForm.TabNextTab1Update(Sender: TObject); +begin + if pcMain.ActivePage = tsConnectionDefinition then + begin + TabNextTab1.Enabled := (cboConnectionDefs.ItemIndex > -1) and ( + (lstCatalog.Items.Count = 0) + or + ((lstCatalog.ItemIndex > -1) and (lstSchema.ItemIndex > -1)) + ); + end; +end; + end. diff --git a/tools/entitygenerator/UtilsU.pas b/tools/entitygenerator/UtilsU.pas index 171b9110..9d776b33 100644 --- a/tools/entitygenerator/UtilsU.pas +++ b/tools/entitygenerator/UtilsU.pas @@ -2,6 +2,9 @@ unit UtilsU; interface +const + DEFAULT_PROJECT_NAME = 'NewEntitiesGeneratorProject'; + function IsReservedKeyword(const Value: String): Boolean; @@ -19,6 +22,8 @@ const PASCAL_KEYWORDS = ';and;array;as;as;asm;begin;break;case;class;class;const 'property;raise;record;reference;repeat;self;set;shl;shr;string;then;threadvar;to;' + 'true;try;type;unit;until;uses;var;while;with;xor;'; + + function IsReservedKeyword(const Value: String): Boolean; begin Result := PASCAL_KEYWORDS.Contains(';' + Value.ToLower + ';');