Implement the new UserForm for configuration recreation:

- new userform and code for configuration recreation - change vtkRecreateConfigurations of vtkMainFunctions.bas - add a WaitForm to inform the user of a long process - fix recreate conf XML and Excel accordind to new signature 429 Unit tests OK, no failure, in 148,63 seconds
jpimbert · Jul 15, 2014 · 912f3a1 · 912f3a1
1 parent 3b56fc2
commit 912f3a1
Show file tree

Hide file tree

Showing 9 changed files with 143 additions and 97 deletions.
diff --git a/Project/VBAToolKit.xml b/Project/VBAToolKit.xml
@@ -463,4 +463,10 @@
         <name>vtkRecreateConfXMLTester</name>
         <modulePath confId="c2">Source\ConfTest\vtkRecreateConfXMLTester.cls</modulePath>
     </module>
+    <module mID="m72">
+        <name>vtkWaitForm</name>
+        <modulePath confId="c1">Source\ConfProd\vtkWaitForm.frm</modulePath>
+        <modulePath confId="c2">Source\ConfProd\vtkWaitForm.frm</modulePath>
+        <modulePath confId="c3">Source\ConfProd\vtkWaitForm.frm</modulePath>
+    </module>
 </vtkConf>
diff --git a/Project/VBAToolKit_DEV.xlsm b/Project/VBAToolKit_DEV.xlsm
diff --git a/Source/ConfProd/vtkMainFunctions.bas b/Source/ConfProd/vtkMainFunctions.bas
@@ -126,33 +126,18 @@ End Function
 '---------------------------------------------------------------------------------------
 ' Procedure  : vtkRecreateConfigurations
 ' Author     : Jean-Pierre Imbert
-' Date       : 08/06/2014
+' Date       : 15/07/2014
 ' Purpose    : recreate one or several configurations
 ' Parameters :
-'             - projectName, string containing the name of the project whose configurations has to be recreate
-'             - confName, string containing the name of configuration
-'             - AllExceptSelected, boolean true if all configurations but confName have to be recreated
+'             - confManager, configuration manager for the configurations to recreate
+'             - confNames, Colelction of the name of the configurations to recreate
 '
 '---------------------------------------------------------------------------------------
 '
-Public Sub vtkRecreateConfigurations(projectName As String, confName As String, Optional AllExceptSelected As Boolean = False)
-    On Error GoTo vtkRecreateConfigurations_Error
-
-    If Not AllExceptSelected Then
-        vtkRecreateConfiguration projectName, confName
-    Else
-        Dim conf As vtkConfiguration, cm As vtkConfigurationManager
-        Set cm = vtkConfigurationManagerForProject(projectName)
-        For Each conf In cm.configurations
-            If Not conf.name Like confName Then
-                vtkRecreateConfiguration projectName, conf.name
-            End If
-        Next
-    End If
-
-    On Error GoTo 0
-    Exit Sub
-
-vtkRecreateConfigurations_Error:
-    Err.Raise Err.Number, Err.Source, Err.Description
+Public Sub vtkRecreateConfigurations(confManager As vtkConfigurationManager, confNames As Collection)
+    Dim c As Variant, confName As String
+    For Each c In confNames
+        confName = c
+        vtkRecreateConfiguration confManager.projectName, confName, confManager
+    Next c
 End Sub
diff --git a/Source/ConfProd/vtkRecreateConfigurationForm.frm b/Source/ConfProd/vtkRecreateConfigurationForm.frm
@@ -1,10 +1,10 @@
 VERSION 5.00
 Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} vtkRecreateConfigurationForm 
    Caption         =   "Recreate Configuration"
-   ClientHeight    =   3120
+   ClientHeight    =   4485
    ClientLeft      =   45
    ClientTop       =   435
-   ClientWidth     =   4710
+   ClientWidth     =   4680
    OleObjectBlob   =   "vtkRecreateConfigurationForm.frx":0000
    StartUpPosition =   1  'CenterOwner
 End
@@ -13,14 +13,13 @@ Attribute VB_GlobalNameSpace = False
 Attribute VB_Creatable = False
 Attribute VB_PredeclaredId = True
 Attribute VB_Exposed = False
-
-
+Option Explicit
 '---------------------------------------------------------------------------------------
 ' Module    : vtkCreateProjectForm
-' Author    : Lucas Vitorino
+' Author    : Jean-Pierre IMBERT
 ' Purpose   : UserForm for VBAToolKit configuration recreation
 '
-' Copyright 2013 Skwal-Soft (http://skwalsoft.com)
+' Copyright 2014 Skwal-Soft (http://skwalsoft.com)
 '
 '   Licensed under the Apache License, Version 2.0 (the "License");
 '   you may not use this file except in compliance with the License.
@@ -36,9 +35,31 @@ Attribute VB_Exposed = False
 '---------------------------------------------------------------------------------------
 
 
-Private cm As vtkConfigurationManager
-Private currentConf As vtkConfiguration
-Private currentProjectName As String
+Private m_confManager As vtkConfigurationManager
+Private m_XMLFilePath As String
+Private m_XMLFileOK As Boolean
+Private m_ConfSelected As Boolean
+
+Private Const PINK = &HC0E0FF
+Private Const GREEN = &HC0FFC0
+
+
+'---------------------------------------------------------------------------------------
+' Procedure : BrowseButton_Click
+' Author    : Jean-Pierre Imbert
+' Date      : 15/07/2014
+' Purpose   : Open a browse window and initialize the XML Configuration File Text field
+'---------------------------------------------------------------------------------------
+'
+Private Sub BrowseButton_Click()
+    With Application.FileDialog(msoFileDialogFilePicker)
+        .AllowMultiSelect = False
+        .Show
+        If .SelectedItems.Count > 0 Then
+            XMLFileTextBox.Text = .SelectedItems(1)
+        End If
+    End With
+End Sub
 
 '---------------------------------------------------------------------------------------
 ' Procedure : UserForm_Initialize
@@ -47,79 +68,49 @@ Private currentProjectName As String
 '---------------------------------------------------------------------------------------
 '
 Private Sub UserForm_Initialize()
-
-    ' Get the name of the current DEV workbook
-    currentProjectName = getCurrentProjectName
-
-    ' Initialize configuration manager
-    Set cm = vtkConfigurationManagerForProject(currentProjectName)
 
-    ' Disable the "Create Configuration" button as no configuration is selected
-    enableCreateConfigurationButton
-
-    ' Initialize the content of the combo box
-    If Not cm Is Nothing Then
-        Dim conf As vtkConfiguration
-        For Each conf In cm.configurations
-            ConfigurationComboBox.AddItem (conf.name)
-        Next
-    End If
+    ' Select the previous XML File Path if any
+    XMLFileTextBox.Text = m_XMLFilePath
+    validateXMLFileTextBox
 
-End Sub
+    ' Disable the "Create Configuration" button as no configuration is selected
+    enableReCreateButton
 
+End Sub
 
 '---------------------------------------------------------------------------------------
-' Procedure : ConfigurationComboBox_Change
-' Author    : Lucas Vitorino
-' Purpose   : Manage the combo box containing the list of configurations
+' Procedure : ConfigurationListBox_AfterUpdate
+' Author    : Jean-Pierre Imbert
+' Purpose   : Manage the list box containing the list of configurations
 '---------------------------------------------------------------------------------------
 '
-Private Sub ConfigurationComboBox_Change()
-
-    On Error GoTo ConfigurationComboBox_Change_Error
-
-    Set currentConf = cm.configurations(ConfigurationComboBox.Value)
-
-    If AllConfigurationsExceptThisOneCheckBox.Value = False Then
-        PathTextBox.Text = currentConf.path
-    End If
-
-    enableCreateConfigurationButton
-
-    On Error GoTo 0
-    Exit Sub
-
-ConfigurationComboBox_Change_Error:
-    Set currentConf = Nothing
-    Resume Next
+Private Sub ConfigurationListBox_AfterUpdate()
+    If m_ConfSelected Then ConfigurationListBox.BackColor = GREEN Else ConfigurationListBox.BackColor = PINK
 End Sub
 
-
 '---------------------------------------------------------------------------------------
-' Procedure : AllConfigurationsExceptThisOneCheckBox_Change
-' Author    : Lucas Vitorino
-' Purpose   : Manage what happens when the checkbox changes.
+' Procedure : ConfigurationListBox_Change
+' Author    : Jean-Pierre Imbert
+' Purpose   : Manage the list box containing the list of configurations
 '---------------------------------------------------------------------------------------
 '
-Private Sub AllConfigurationsExceptThisOneCheckBox_Change()
-
-    If AllConfigurationsExceptThisOneCheckBox.Value = True Or currentConf Is Nothing Then
-        PathTextBox.Text = ""
-    Else
-        PathTextBox.Text = currentConf.path
-    End If
-
+Private Sub ConfigurationListBox_Change()
+    Dim i As Integer
+    m_ConfSelected = False
+    For i = 0 To ConfigurationListBox.ListCount - 1
+        m_ConfSelected = m_ConfSelected Or ConfigurationListBox.Selected(i)
+    Next i
+    enableReCreateButton
 End Sub
 
-
 '---------------------------------------------------------------------------------------
 ' Procedure : CancelButton_Click
 ' Author    : Lucas Vitorino
 ' Purpose   : Close the form
 '---------------------------------------------------------------------------------------
 '
 Private Sub CancelButton_Click()
-    Unload vtkRecreateConfigurationForm
+    vtkRecreateConfigurationForm.Hide
 End Sub
 
 
@@ -130,20 +121,65 @@ End Sub
 '---------------------------------------------------------------------------------------
 '
 Private Sub CreateConfigurationButton_Click()
-    vtkRecreateConfigurations projectName:=currentProjectName, confName:=currentConf.name, AllExceptSelected:=AllConfigurationsExceptThisOneCheckBox.Value
+    Me.Hide
+    ' display wait message modeless for the present code to keep running
+    vtkWaitForm.Show vbModeless
+    ' build the confNames collection
+    Dim confNames As New Collection, i As Integer
+    For i = 0 To ConfigurationListBox.ListCount - 1
+        If ConfigurationListBox.Selected(i) Then confNames.Add ConfigurationListBox.List(i)
+    Next i
+    ' recreate configurations
+    vtkRecreateConfigurations m_confManager, confNames
+    ' Hide wait message
+    vtkWaitForm.Hide
 End Sub
 
-
 '---------------------------------------------------------------------------------------
-' Procedure : enableCreateConfigurationButton
-' Author    : Lucas Vitorino
-' Purpose   : Decide if the "Create Configuration" button should be enabled or disabled.
+' Procedure : validateXMLFileTextBox
+' Author    : Jean-Pierre Imbert
+' Date      : 15/07/2014
+' Purpose   : Check the XMLFileTextBox and establish status of the form
+'
 '---------------------------------------------------------------------------------------
 '
-Private Sub enableCreateConfigurationButton()
-    If currentConf Is Nothing Then
-        CreateConfigurationButton.Enabled = False
-    Else
-        CreateConfigurationButton.Enabled = True
+Private Sub validateXMLFileTextBox()
+    Dim cmX As New vtkConfigurationManagerXML, conf As vtkConfiguration
+   On Error Resume Next
+    cmX.init XMLFileTextBox.Text
+    m_XMLFileOK = (Err.Number = 0)
+   On Error GoTo 0
+    ConfigurationListBox.Clear
+    m_ConfSelected = False
+    If m_XMLFileOK Then
+        XMLFileTextBox.BackColor = GREEN
+        m_XMLFilePath = XMLFileTextBox.Text
+        Set m_confManager = cmX
+        For Each conf In m_confManager.configurations
+            ConfigurationListBox.AddItem conf.name
+        Next conf
+       Else
+        XMLFileTextBox.BackColor = PINK
+        m_XMLFilePath = ""
+        Set m_confManager = Nothing
     End If
+    enableReCreateButton
+End Sub
+
+'---------------------------------------------------------------------------------------
+' Procedure : enableReCreateButton
+' Author    : Jean-Pierre Imbert
+' Date      : 15/07/2014
+' Purpose   : Enable the ReCreate Button only if all parameters are typed and OK
+'
+'---------------------------------------------------------------------------------------
+'
+Private Sub enableReCreateButton()
+    ' Enable ReCreate Button only if all parameters are OK
+    CreateConfigurationButton.Enabled = m_XMLFileOK And m_ConfSelected
+End Sub
+
+
+Private Sub XMLFileTextBox_Change()
+    validateXMLFileTextBox
 End Sub
diff --git a/Source/ConfProd/vtkRecreateConfigurationForm.frx b/Source/ConfProd/vtkRecreateConfigurationForm.frx
diff --git a/Source/ConfProd/vtkWaitForm.frm b/Source/ConfProd/vtkWaitForm.frm
@@ -0,0 +1,15 @@
+VERSION 5.00
+Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} vtkWaitForm 
+   Caption         =   "VBAToolKit"
+   ClientHeight    =   675
+   ClientLeft      =   45
+   ClientTop       =   435
+   ClientWidth     =   4770
+   OleObjectBlob   =   "vtkWaitForm.frx":0000
+   StartUpPosition =   1  'CenterOwner
+End
+Attribute VB_Name = "vtkWaitForm"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
diff --git a/Source/ConfProd/vtkWaitForm.frx b/Source/ConfProd/vtkWaitForm.frx
diff --git a/Source/ConfTest/vtkRecreateConfExcelTester.cls b/Source/ConfTest/vtkRecreateConfExcelTester.cls
@@ -226,7 +226,9 @@ Public Sub Test_vtkRecreateConfigurations_normalConf()
     Set testedConf = normalConf
 
     vtkExportConfiguration Wb.VBProject, testProject.projectName, testedConf.name
-    vtkRecreateConfigurations testProject.projectName, testedConf.name
+    Dim confNames As New Collection
+    confNames.Add testedConf.name
+    vtkRecreateConfigurations cm, confNames
     Set recreatedWb = Workbooks.Open(VBAToolKit.vtkTestPath & "\" & testProject.projectName & "\" & testedConf.path)
 
     mAssert.Should fso.FileExists(VBAToolKit.vtkTestPath & "\" & testProject.projectName & "\" & testedConf.path), _

diff --git a/Source/ConfTest/vtkRecreateConfXMLTester.cls b/Source/ConfTest/vtkRecreateConfXMLTester.cls
@@ -233,7 +233,9 @@ Public Sub Test_vtkRecreateConfigurations_normalConf()
     Set testedConf = normalConf
 
     vtkExportConfiguration Wb.VBProject, testProject.projectName, testedConf.name
-    vtkRecreateConfigurations testProject.projectName, testedConf.name
+    Dim confNames As New Collection
+    confNames.Add testedConf.name
+    vtkRecreateConfigurations cm, confNames
     Set recreatedWb = Workbooks.Open(VBAToolKit.vtkTestPath & "\" & testProject.projectName & "\" & testedConf.path)
 
     mAssert.Should fso.FileExists(VBAToolKit.vtkTestPath & "\" & testProject.projectName & "\" & testedConf.path), _