'TITLE: SWITCH DOMAIN BINDINGS 'DESCRIPTION: This macro scans all the columns and attributes in the active model or all models ' and switches the domain bindings from the source domain to the target domain. The ' information for each bound column will be updated with the target domain. Any domain ' overrides will be preserved. 'AUTHOR: Jason Tiret 'CONTACT: http://support.embarcadero.com/ 'LAST UPDATE: 5/27/2003 Dim attr As AttributeObj Dim ent As Entity Dim mdl As Model Dim diag As Diagram Dim dom As Domain Dim dict As Dictionary Dim target_dom As Domain Dim source_dom As Domain Dim target_dict As Dictionary Dim source_dict As Dictionary 'dialog variables and arrays Dim dictionary_list () As String Dim source_domain_names() As String Dim target_domain_names() As String Dim target_dom_index As Integer Dim source_dom_index As Integer Dim target_dict_index As Integer Dim source_dict_index As Integer Sub Main Debug.Clear Set diag = DiagramManager.ActiveDiagram Set mdl = diag.ActiveModel Begin Dialog UserDialog 970,175,"Switch Domains",.dom_handler ' %GRID:10,7,1,1 DropListBox 170,14,290,112,dictionary_list(),.source_dict_list DropListBox 170,56,290,91,dictionary_list(),.target_dict_list DropListBox 620,14,300,98,source_domain_names(),.Source_domain_dd Text 480,56,110,14,"Target Domain",.trgt_domain Text 480,14,110,14,"Source Domain",.src_domain DropListBox 620,56,300,91,target_domain_names(),.Target_domain_dd PushButton 690,112,100,28,"&Switch",.switch GroupBox 40,98,410,49,"Scope",.GroupBox1 Text 30,14,140,14,"Source Dictionary",.Text1 Text 30,56,130,14,"Target Dictionary",.Text2 OptionGroup .modelscope OptionButton 90,119,120,14,"&Active Model",.optionbutton1 OptionButton 230,119,130,14,"A&ll Models",.OptionButton2 CancelButton 820,112,90,28 PushButton 820,112,100,28,"&Close",.Close_dialog End Dialog Dim dlg As UserDialog init_local_domains "SOURCE" init_local_domains "TARGET" init_dictionary_list dhQuickSort(source_domain_names) dhQuickSort(target_domain_names) target_domain_index = 0 source_domain_index = 0 dlg.modelscope = 1 Set source_dict = diag.Dictionary Set target_dict = diag.Dictionary If Dialog(dlg) = -1 Then End If End Sub 'initialize the dictionary drop down list Sub init_dictionary_list ReDim dictionary_list (0 To diag.EnterpriseDataDictionaries.Count) As String dictionary_list (0) = "Local" i = 1 For Each dict In diag.EnterpriseDataDictionaries dictionary_list (i) = dict.Name i = i + 1 Next End Sub 'Initialize the domains dropdown array Sub init_local_domains (loadoption As String) If diag.Dictionary.Domains.Count = 0 Then ReDim source_domain_names (0) As String ReDim target_domain_names (0) As String source_domain_names (0) = "NONE" target_domain_names (0) = "NONE" Else If loadoption = "SOURCE" Then ReDim source_domain_names(0 To diag.Dictionary.Domains.Count - 1) As String Else ReDim target_domain_names(0 To diag.Dictionary.Domains.Count - 1) As String End If Dim i As Integer i = 0 For Each dom In diag.Dictionary.Domains If loadoption = "SOURCE" Then source_domain_names(i) = dom.Name Else target_domain_names(i) = dom.Name End If i = i + 1 Next End If End Sub 'initialize the domains drop down if an Enterprise dictionary is set Sub init_enterprise_domains (dict_name As String, loadoption As String) Set dict = diag.EnterpriseDataDictionaries.Item(dict_name) If dict.Domains.Count = 0 Then ReDim source_domain_names (0) As String ReDim target_domain_names (0) As String source_domain_names (0) = "NONE" target_domain_names (0) = "NONE" Else If loadoption = "SOURCE" Then ReDim source_domain_names(0 To dict.Domains.Count - 1) As String Else ReDim target_domain_names(0 To dict.Domains.Count - 1) As String End If i = 0 For Each dom In dict.Domains If loadoption = "SOURCE" Then source_domain_names(i) = dom.Name Else target_domain_names(i) = dom.Name End If i = i + 1 Next End If End Sub Sub switch_domains (src_ix As Integer, trg_ix As Integer) Debug.Print "Switch Domains" Set target_dom = target_dict.Domains.Item(target_domain_names(trg_ix)) Set source_dom = source_dict.Domains.Item(source_domain_names(src_ix)) Debug.Print "Switch - source dom: " & source_dom.Name Debug.Print "Switch - target dom: " & target_dom.Name For Each ent In mdl.Entities Debug.Print "Entity Name: " & ent.EntityName For Each attr In ent.Attributes Debug.Print vbTab & "Attribute Name: " & attr.AttributeName Debug.Print vbTab & vbTab & "Attribute Domain ID: " & attr.DomainId Debug.Print vbTab & vbTab & "Src Dict Domain ID: " & source_dom.ID Debug.Print vbTab & vbTab & "trgt Dict domain ID: " & target_dom.ID 'match domain id with attribute domain If attr.DomainId = source_dom.ID Then Debug.Print vbTab & vbTab & "MATCH!" attr.DomainId = target_dom.ID 'set attribute domain id to target domain End If Debug.Print vbCrLf Next Next End Sub
Rem See DialogFunc help topic for more information. Private Function dom_handler(DlgItem$, Action%, SuppValue&) As Boolean Select Case Action% Case 1 ' Dialog box initialization ' DlgEnable "Cancel", False DlgVisible "Cancel", False Case 2 ' Value changing or button pressed If DlgItem = "switch" Then 'debug check for right source domain Debug.Print "Source Domain Index: " & source_dom_index Set source_dom = source_dict.Domains.Item(source_domain_names(source_dom_index)) Debug.Print "Src Domain: " & source_dom.Name 'debug check for right target domain Debug.Print "Target Domain Index: " & target_dom_index Set target_dom = target_dict.Domains.Item(target_domain_names(target_dom_index)) Debug.Print "Trgt Domain: " & target_dom.Name ' definition_override = DlgValue("definition_overrides") ' default_override = DlgValue("default_overrides") ' rule_override = DlgValue("rule_overrides") If DlgValue("modelscope") = 0 Then Debug.Print "Active Model." 'only update domain bindings in current model switch_domains source_dom_index, target_dom_index Else Debug.Print "All Models." 'update all models For Each mdl In diag.Models switch_domains source_dom_index, target_dom_index Next End If MsgBox(" DONE!! ",,"ER/Studio") dom_handler = True ' Prevent button press from closing the dialog box ElseIf DlgItem = "Source_domain_dd" Then source_dom_index = SuppValue dom_handler = True ' Prevent button press from closing the dialog box ElseIf DlgItem = "Target_domain_dd" Then target_dom_index = SuppValue dom_handler = True ' Prevent button press from closing the dialog box ElseIf DlgItem = "source_dict_list" Then source_dict_index = SuppValue If dictionary_list(SuppValue) = "Local" Then Set source_dict = diag.Dictionary init_local_domains "SOURCE" dhQuickSort(source_domain_names) DlgListBoxArray "Source_domain_dd", source_domain_names dom_handler = True Else Set source_dict = diag.EnterpriseDataDictionaries.Item(dictionary_list(SuppValue)) init_enterprise_domains source_dict.Name, "SOURCE" dhQuickSort(source_domain_names) DlgListBoxArray "Source_domain_dd", source_domain_names dom_handler = True End If ElseIf DlgItem = "target_dict_list" Then target_dict_index = SuppValue If dictionary_list(SuppValue) = "Local" Then Set target_dict = diag.Dictionary init_local_domains "TARGET" dhQuickSort(target_domain_names) DlgListBoxArray "Target_domain_dd", target_domain_names dom_handler = True Else Set target_dict = diag.EnterpriseDataDictionaries.Item(dictionary_list(SuppValue)) init_enterprise_domains target_dict.Name, "TARGET" dhQuickSort(target_domain_names) DlgListBoxArray "Target_domain_dd", target_domain_names dom_handler = True End If End If Rem dom_handler = True ' Prevent button press from closing the dialog box Case 3 ' TextBox or ComboBox text changed Case 4 ' Focus changed Case 5 ' Idle Rem dom_handler = True ' Continue getting idle actions Case 6 ' Function key End Select End Function ' 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