'TITLE: DEFINITION EDITOR.BAS 'DESCRIPTION: This macro will list all the tables and allow ' the user to update the definition field for the table, by ' pressing the "update" button. There will also be a list of ' columns for the respective table, that the user can use to update ' the definitions for each column. This macro will run on a ' logical or a physical model and populate the lists accordingly. 'AUTHOR: Jason Tiret 'CONTACT: http://support.embarcadero.com/ 'DATE: 5/29/2001 Option Explicit 'Array variables for the dialog Dim TableArray() As String Dim TableDef() As String Dim tableIndx As Integer Dim ColumnArray() As String Dim ColumnDef() As String Dim colIndx As Integer 'Auto-Update variables Dim AutoTables As Boolean Dim AutoColumns As Boolean Dim UpdateBit As Boolean 'ERStudio global variables Dim MyModel As Model Dim MyDiagram As Diagram Dim MyEntity As Entity Dim MyAttribute As AttributeObj Dim EntCount As Integer Dim ColCount As Integer 'This function is used to populate the TableArray variable with 'the list of tables from the active model. It will use logical names 'when run on a logical model. It will use physical names when run on 'a physical model. It takes no parameters and returns no value. Function getTables() Dim indx As Integer indx = 0 EntCount = MyModel.Entities.Count - 1 're-initialize the table array to the appropriate size ReDim TableArray(0 To EntCount) As String 'loop through each entity in the active model For Each MyEntity In MyModel.Entities If MyModel.Logical = True Then 'Use the Entity name if the model is logical TableArray(indx) = MyEntity.EntityName Else 'Use the Table name if the model is physical TableArray(indx) = MyEntity.TableName End If indx = indx + 1 Next MyEntity dhQuickSort TableArray End Function 'This function gets the columns for repective table. It will refresh the 'ColumnArray variable with the columns from the selected table. It will 'use the logical names when run on a logical model. It will use physical 'names when run on a physical model. It returns nothing. The parameter is 'the table name that columns need to be refreshed. Function getColumns(TableName As String) Dim indx As Integer Dim count As Integer Dim quit As Boolean count = 1 indx = 0 Set MyEntity = MyModel.Entities.Item(TableName) ColCount = MyEntity.Attributes.Count 'Re-initailize the column array with the number of columns in the table ReDim ColumnArray(0 To ColCount) As String For count = 1 To ColCount For Each MyAttribute In MyEntity.Attributes 'Attributes will be inserted into the column array by sequence number '(displayed order, not created order) If MyAttribute.SequenceNumber = count Then 'Need to determine to use logical or physical names If MyModel.Logical = True Then If MyAttribute.HasLogicalRoleName = True Then 'Use logical rolename instead of attribute name ColumnArray(indx) = MyAttribute.LogicalRoleName Else 'Use attribute name if no rolename is used ColumnArray(indx) = MyAttribute.AttributeName End If Else If MyAttribute.HasRoleName = True Then 'use rolename instead of column name ColumnArray(indx) = MyAttribute.RoleName Else 'Use column name if no rolename is used ColumnArray(indx) = MyAttribute.ColumnName End If End If indx = indx + 1 End If Next MyAttribute Next count End Function 'This function returns the defintion of the specified table name. The 'table name is passed in as a parameter. This function is used to 'populate the table definition of the dialog. Function getTableDef (tname As String) As String Set MyEntity = MyModel.Entities.Item(tname) getTableDef = MyEntity.Definition End Function 'This function returns the definition of the specified attribute in the 'specified table. The column name and table name are passed in parameters 'This function is used to populate the column defintion in the dialog. Function getColumnDef (tname As String, cname As String) As String Set MyEntity = MyModel.Entities.Item(tname) Set MyAttribute = MyEntity.Attributes.Item(cname) If cname = "" Then getColumnDef = "" Else getColumnDef = MyAttribute.Definition End If End Function Sub Main Debug.Clear 'initialize ER variables Set MyDiagram = DiagramManager.ActiveDiagram Set MyModel = MyDiagram.ActiveModel 'initialize indexes for dialog arrays tableIndx = 0 colIndx = 0 'initialize auto update variables for dialog AutoTables = True AutoColumns = True UpdateBit = False 'initialize dialog arrays getTables() getColumns(TableArray(0)) Begin Dialog UserDialog 980,525,"Definition Editor",.MyDialogFunc ' %GRID:10,7,1,1 GroupBox 20,7,940,231,"Table Definitions",.GroupBox1 GroupBox 20,252,940,231,"Column Definitions",.GroupBox2 ListBox 40,28,200,182,TableArray(),.TableList ListBox 40,273,200,182,ColumnArray(),.ColumnList TextBox 260,28,680,168,.TableDefinition,1 TextBox 260,273,680,168,.ColumnDefinition,1 PushButton 820,203,120,21,"Update",.UpdateTable PushButton 820,448,120,21,"Update",.UpdateColumn OKButton 820,490,140,28 CheckBox 470,210,300,14,"Automatically Update Tables Definitions",.autoTab CheckBox 470,455,300,14,"Automatically Update Column Definitions",.autoCol End Dialog Dim dlg As UserDialog 'initialize dialog parameters dlg.autoTab = 1 dlg.autoCol = 1 dlg.tabledefinition = getTableDef(TableArray(0)) dlg.columndefinition = getColumnDef(TableArray(0),ColumnArray(0)) Dialog dlg, -2 End Sub
Rem See DialogFunc help topic for more information. Private Function MyDialogFunc(DlgItem$, Action%, SuppValue&) As Boolean Dim value As Integer Select Case Action% Case 1 ' Dialog box initialization 'DlgText "ColumnDefinition", getColumnDef(TableArray(0),ColumnArray(0)) Case 2 ' Value changing or button pressed Rem MyDialogFunc = True ' Prevent button press from closing the dialog box If DlgItem = "autoTab" Then 'set AutoTables variable to match checkbox value = DlgValue("autoTab") If value = 0 Then AutoTables = False Else AutoTables = True End If UpdateBit = False ElseIf DlgItem = "autoCol" Then 'set AutoColumns variable top match checkbox value = DlgValue("autoCol") If value = 0 Then AutoColumns = False Else AutoColumns = True End If UpdateBit = False ElseIf DlgItem = "TableList" Then 'insert table def into the TableDefinition dialog variable DlgText "TableDefinition", getTableDef(TableArray(SuppValue)) 'refresh column list with columns from selected table getColumns(TableArray(SuppValue)) DlgListBoxArray "ColumnList", ColumnArray Debug.Print "table= " & TableArray(SuppValue) tableIndx = SuppValue 'insert column def into the ColumnDefinition dialog variable DlgText "ColumnDefinition", "" ' getColumnDef(TableArray(tableIndx),ColumnArray(0)) UpdateBit = False MyDialogFunc = True ElseIf DlgItem = "ColumnList" Then 'insert column def into the ColumnDefinition dialog variable DlgText "ColumnDefinition", getColumnDef(TableArray(tableIndx), ColumnArray(SuppValue)) colIndx = SuppValue UpdateBit = True MyDialogFunc = True End If If DlgItem = "UpdateTable" Then Set MyEntity = MyModel.Entities.Item(TableArray(tableIndx)) 'update the corresponding table definition when update Tables button is pushed. MyEntity.Definition = DlgText("TableDefinition") UpdateBit = False MyDialogFunc = True ElseIf DlgItem = "UpdateColumn" Then Set MyEntity = MyModel.Entities.Item(TableArray(tableIndx)) Set MyAttribute = MyEntity.Attributes.Item(ColumnArray(colIndx)) 'update the corresponding column definition when update columns button is pushed. MyAttribute.Definition = DlgText("ColumnDefinition") UpdateBit = True MyDialogFunc = True End If Case 3 ' TextBox or ComboBox text changed 'Auto update when text block is changed and loses focus. If DlgItem = "TableDefinition" And AutoTables = True Then Set MyEntity = MyModel.Entities.Item(TableArray(tableIndx)) 'update table definition MyEntity.Definition = DlgText("TableDefinition") UpdateBit = False MyDialogFunc = True ElseIf DlgItem = "ColumnDefinition" And AutoColumns = True Then If UpdateBit = True Then Set MyEntity = MyModel.Entities.Item(TableArray(tableIndx)) Set MyAttribute = MyEntity.Attributes.Item(ColumnArray(colIndx)) 'update column definition MyAttribute.Definition = DlgText("ColumnDefinition") MyDialogFunc = True End If End If Case 4 ' Focus changed Case 5 ' Idle Rem MyDialogFunc = True ' Continue getting idle actions Case 6 ' Function key End Select End Function ' **The following code is taken from the specified book. It has been modified ' **to perform a case insensitive sort. ' From "VBA Developer's Handbook" ' by Ken Getz and Mike Gilbert ' Copyright 1997; Sybex, Inc. All rights reserved. ' Quicksort for simple data types. ' Indicate that a parameter is missing. Const dhcMissing = -2 Sub dhQuickSort(varArray As Variant, _ Optional intLeft As Integer As Integer ' From "VBA Developer's Handbook" ' by Ken Getz and Mike Gilbert ' Copyright 1997; Sybex, Inc. All rights reserved. ' Entry point for sorting the array. ' This technique uses the recursive Quicksort ' algorithm to perform its sort. ' In: ' varArray: ' A variant pointing to an array to be sorted. ' This had better actually be an array, or the ' code will fail, miserably. You could add ' a test for this: ' If Not IsArray(varArray) Then Exit Sub ' but hey, that would slow this down, and it's ' only YOU calling this procedure. ' Make sure it's an array. It's your problem. ' intLeft: ' intRight: ' Lower and upper bounds of the array to be sorted. ' If you don't supply these values (and normally, you won't) ' the code uses the LBound and UBound functions ' to get the information. In recursive calls ' to the sort, the caller will pass this information in. ' To allow for passing integers around (instead of ' larger, slower variants), the code uses -2 to indicate ' that you've not passed a value. This means that you won't ' be able to use this mechanism to sort arrays with negative ' indexes, unless you modify this code. ' Out: ' The data in varArray will be sorted. Dim i As Integer Dim j As Integer Dim varTestVal As Variant Dim intMid As Integer If intLeft = dhcMissing Then intLeft = LBound(varArray) If intRight = dhcMissing Then intRight = UBound(varArray) If intLeft < intRight Then intMid = (intLeft + intRight) \ 2 varTestVal = UCase(varArray(intMid)) i = intLeft j = intRight Do Do While UCase(varArray(i)) < varTestVal i = i + 1 Loop Do While UCase(varArray(j)) > varTestVal j = j - 1 Loop If i <= j Then SwapElements varArray, i, j i = i + 1 j = j - 1 End If Loop Until i > j ' To optimize the sort, always sort the ' smallest segment first. If j <= intMid Then Call dhQuickSort(varArray, intLeft, j) Call dhQuickSort(varArray, i, intRight) Else Call dhQuickSort(varArray, i, intRight) Call dhQuickSort(varArray, intLeft, j) End If End If End Sub
Private Sub SwapElements(varItems As Variant, intItem1 As Integer, intItem2 As Integer) Dim varTemp As Variant varTemp = varItems(intItem2) varItems(intItem2) = varItems(intItem1) varItems(intItem1) = varTemp End Sub