VERSION 1.0 CLASS BEGIN MultiUse = -1 'True END Attribute VB_Name = "s_Config" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = False Option Explicit Private fso_ As Scripting.FileSystemObject Private config_ As InfoConfig Private wordApp_ As API_WordWrapper ' TODO: ' Public Function SyncDocument(target As Word.Document) ' Public Function SaveAs(outPath$) As Boolean ' Public Function Save() As Boolean ' Public Function CreateStyle(targetID&, sStyleName$, iDoc As Word.Document) As Boolean Public Function Setup() ' Mandatory setup function Set config_ = New InfoConfig Set fso_ = New Scripting.FileSystemObject Set wordApp_ = New API_WordWrapper Call wordApp_.SetApplication(ThisDocument.Application) Call ResetTestFolder End Function Public Function Teardown() ' Mandatory teardown function Call fso_.DeleteFolder(GetTestFolder) End Function Public Function t_Load() On Error GoTo PROPAGATE_ERROR Call Dev_NewCase("Valid load") Call config_.Load(SetupTestConfig) Call Dev_ExpectTrue(config_.IsLoaded) Call Dev_ExpectEQ(3, config_.categories_.Count) Call Dev_NewCase("Missing file") Dim iConfig As New InfoConfig Call Dev_ExpectFalse(iConfig.IsLoaded) Call Dev_ExpectFalse(iConfig.Load("invalid file")) Call Dev_ExpectFalse(iConfig.IsLoaded) Call Dev_ExpectEQ(0, iConfig.categories_.Count) Call Dev_NewCase("Invalid file") Dim sFile$: sFile = GetTestFolder & "\" & "test1.docx" Dim iWord As New API_WordWrapper: Call iWord.NewDocument Call iWord.SaveAs(sFile) Call iWord.ReleaseDocument Call Dev_ExpectFalse(iConfig.Load(sFile)) Call Dev_ExpectFalse(iConfig.IsLoaded) Call Dev_ExpectEQ(0, iConfig.categories_.Count) Exit Function PROPAGATE_ERROR: Call Dev_LogError(Err.Number, Err.Description) End Function Public Function t_BasicCategory() On Error GoTo PROPAGATE_ERROR Dim iCat As InfoCategory Call Dev_ExpectNothing(config_.AddBasicCategory("", ""), "Empty name") Call Dev_ExpectNothing(config_.GetAt(1)) Call Dev_NewCase("Empty info") Set iCat = config_.AddBasicCategory("test1", "") Call Dev_AssertNotNothing(iCat) Call Dev_ExpectEQ(1, iCat.id_) Call Dev_ExpectEQ("test1", iCat.name_) Call Dev_ExpectEQ("", iCat.info_) Call Dev_ExpectEQ(iCat, config_.GetAt(1)) Call Dev_ExpectEQ(0, config_.CountCombos) Call Dev_ExpectEQ(1, config_.CountIncomplete) iCat.style_ = "TStyle" Call Dev_ExpectEQ(0, config_.CountIncomplete) Call Dev_NewCase("Valid basic") Set iCat = config_.AddBasicCategory("test2", "info") Call Dev_AssertNotNothing(iCat) Call Dev_ExpectEQ(2, iCat.id_) Call Dev_ExpectEQ("test2", iCat.name_) Call Dev_ExpectEQ("info", iCat.info_) Call Dev_ExpectEQ(0, config_.CountCombos) Call Dev_ExpectEQ(1, config_.CountIncomplete) Call Dev_NewCase("Duplicate") On Error Resume Next Call Dev_ExpectNothing(config_.AddBasicCategory("test1", "123")) Call Dev_ExpectError(ERR_CAT_NAME_TAKEN) Exit Function PROPAGATE_ERROR: Call Dev_LogError(Err.Number, Err.Description) End Function Public Function t_ComboCategory() On Error GoTo PROPAGATE_ERROR Dim iCombo As InfoCategory Call Dev_ExpectNothing(config_.AddCombinedCategory("", CSet()), "Empty name") Call Dev_NewCase("Name taken") Dim iBase1 As InfoCategory: Set iBase1 = config_.AddBasicCategory("base1", "info1") Dim iBase2 As InfoCategory: Set iBase2 = config_.AddBasicCategory("base2", "info2") Dim iComp As Scripting.Dictionary: Set iComp = CSet(iBase1.id_, iBase2.id_) On Error Resume Next Call Dev_ExpectNothing(config_.AddCombinedCategory("base1", iComp)) Call Dev_ExpectError(ERR_CAT_NAME_TAKEN) On Error GoTo PROPAGATE_ERROR Call Dev_NewCase("Invalid combo cat") On Error Resume Next Call Dev_ExpectNothing(config_.AddCombinedCategory("derived", CSet(iBase1.id_ + iBase2.id_, iBase1.id_), "info3")) Call Dev_ExpectError(EM_UNKNOWN_CAT_ID) On Error GoTo PROPAGATE_ERROR Call Dev_NewCase("Valid combo add") Set iCombo = config_.AddCombinedCategory("derived", iComp, "info3") Call Dev_AssertNotNothing(iCombo) Call Dev_ExpectEQ(3, config_.categories_.Count, "Cats count") Call Dev_ExpectEQ(1, config_.CountCombos) Call Dev_ExpectEQ(3, config_.CountIncomplete) Call Dev_ExpectEQ(3, iCombo.id_) Call Dev_ExpectEQ("derived", iCombo.name_) Call Dev_ExpectEQ("info3", iCombo.info_) Call Dev_ExpectEQ(iComp, iCombo.composition_) Call Dev_NewCase("Combo taken") On Error Resume Next Call Dev_ExpectNothing(config_.AddCombinedCategory("derived", iComp, "info3")) Call Dev_ExpectError(ERR_COMBO_TAKEN) On Error GoTo PROPAGATE_ERROR Exit Function PROPAGATE_ERROR: Call Dev_LogError(Err.Number, Err.Description) End Function Public Function t_EraseCategory() On Error GoTo PROPAGATE_ERROR Call Dev_NewCase("Empty config") Call Dev_ExpectFalse(config_.EraseCategory(1337)) Call Dev_NewCase("Missing id") Dim iCat As InfoCategory: Set iCat = config_.AddBasicCategory("test", "info") Call Dev_ExpectFalse(config_.EraseCategory(iCat.id_ + 1)) Call Dev_ExpectEQ(1, config_.categories_.Count) Call Dev_NewCase("Valid erase basic") Call Dev_ExpectTrue(config_.EraseCategory(iCat.id_)) Call Dev_ExpectEQ(0, config_.categories_.Count) Call Dev_NewCase("Delete with dependencies") Dim iParent1 As InfoCategory: Set iParent1 = config_.AddBasicCategory("test1", "info") Dim iParent2 As InfoCategory: Set iParent2 = config_.AddBasicCategory("test2", "info") Dim iChild As InfoCategory: Set iChild = config_.AddCombinedCategory("test3", CSet(iParent1.id_), "info") Call Dev_ExpectTrue(config_.EraseCategory(iParent1.id_)) Call Dev_ExpectEQ(1, config_.categories_.Count) Call Dev_ExpectTrue(config_.Contains(iParent2.id_)) Exit Function PROPAGATE_ERROR: Call Dev_LogError(Err.Number, Err.Description) End Function Public Function t_Access() On Error GoTo PROPAGATE_ERROR Call Dev_NewCase("Empty config") Call Dev_ExpectFalse(config_.Contains(1337), "Contains") Call Dev_ExpectNothing(config_.GetAt(1337), "GetAt") Call Dev_ExpectNothing(config_.FindName("test"), "FindName") Call Dev_ExpectNothing(config_.FindStyle("style"), "FindStyle") Call Dev_ExpectNothing(config_.FindComposition(CSet(1, 2)), "FindComposition") Call Dev_NewCase("Valid access") Dim iBase1 As InfoCategory: Set iBase1 = config_.AddBasicCategory("base1", "info1") Dim iBase2 As InfoCategory: Set iBase2 = config_.AddBasicCategory("base2", "info2") iBase1.style_ = "style" Dim iComp As Scripting.Dictionary: Set iComp = CSet(iBase1.id_, iBase2.id_) Dim iChild As InfoCategory: Set iChild = config_.AddCombinedCategory("derived", iComp, "info3") Call Dev_ExpectTrue(config_.Contains(iBase1.id_), "Contains") Call Dev_ExpectEQ(iBase2, config_.GetAt(iBase2.id_), "GetAt") Call Dev_ExpectEQ(iChild, config_.FindName("derived"), "FindName") Call Dev_ExpectEQ(iBase1, config_.FindStyle("style"), "FindStyle") Call Dev_ExpectEQ(iChild, config_.FindComposition(iComp), "FindComposition") Call Dev_NewCase("Invalid access") Call Dev_ExpectFalse(config_.Contains(1337), "Contains") Call Dev_ExpectNothing(config_.GetAt(1337), "GetAt") Call Dev_ExpectNothing(config_.FindName("test123"), "FindName") Call Dev_ExpectNothing(config_.FindStyle("style123"), "FindStyle") Call Dev_ExpectNothing(config_.FindComposition(CSet(1, 2, 3, 4)), "FindComposition") Exit Function PROPAGATE_ERROR: Call Dev_LogError(Err.Number, Err.Description) End Function Public Function t_ReduceComposition() On Error GoTo PROPAGATE_ERROR Call Dev_NewCase("Empty config") Call Dev_ExpectEQ(CSet(), config_.ReduceComposition(CSet)) Call config_.AddBasicCategory("base1") ' 1 Call config_.AddBasicCategory("base2") ' 2 Call config_.AddBasicCategory("base3") ' 3 Call config_.AddCombinedCategory("derived1", CSet(1, 2)) ' 4 Call config_.AddCombinedCategory("derived2", CSet(3, 4)) ' 5 Call Dev_NewCase("Invalid id") Call Dev_ExpectNothing(config_.ReduceComposition(CSet(1, 1337))) Call Dev_NewCase("Valid reductions") Call Dev_ExpectEQ(CSet(1), config_.ReduceComposition(CSet(1))) Call Dev_ExpectEQ(CSet(1, 2), config_.ReduceComposition(CSet(4))) Call Dev_ExpectEQ(CSet(1, 2, 3), config_.ReduceComposition(CSet(5))) Exit Function PROPAGATE_ERROR: Call Dev_LogError(Err.Number, Err.Description) End Function Public Function t_GetChildrenOf() On Error GoTo PROPAGATE_ERROR Call Dev_NewCase("Empty config") Call Dev_ExpectNothing(config_.GetChildrenOf(1337)) Call config_.AddBasicCategory("base1") ' 1 Call config_.AddBasicCategory("base2") ' 2 Call config_.AddBasicCategory("base3") ' 3 Call config_.AddCombinedCategory("derived1", CSet(1, 2)) ' 4 Call config_.AddCombinedCategory("derived2", CSet(3, 4)) ' 5 Call Dev_NewCase("Valid ids") Call Dev_ExpectEQ(CSet(), config_.GetChildrenOf(5), "Parent category") Call Dev_ExpectEQ(CSet(5), config_.GetChildrenOf(4)) Call Dev_ExpectEQ(CSet(4, 5), config_.GetChildrenOf(1)) Exit Function PROPAGATE_ERROR: Call Dev_LogError(Err.Number, Err.Description) End Function Public Function t_SyncStyles() On Error GoTo PROPAGATE_ERROR Call config_.Load(SetupTestConfig) Dim iDoc As Word.Document: Set iDoc = wordApp_.NewDocument() Call Dev_NewCase("Empty config") Dim iConfig As New InfoConfig On Error Resume Next Call iConfig.SyncStyles(wordApp_.Application, iDoc.Path) Call iConfig.SyncStyles(wordApp_.Application, iDoc.Path) Call Dev_ExpectNoError On Error GoTo PROPAGATE_ERROR Call Dev_NewCase("Valid transfer") Call config_.AddBasicCategory("TestIncomplete") On Error Resume Next Call config_.SyncStyles(wordApp_.Application, iDoc.Path) Call Dev_ExpectNoError On Error GoTo PROPAGATE_ERROR Call config_.SyncStyles(wordApp_.Application, iDoc.FullName) Call Dev_ExpectTrue(WordStyleExists(iDoc, config_.categories_(1).style_)) Call wordApp_.ReleaseDocument(bCloseApplication:=False, bSaveChanges:=False) Exit Function PROPAGATE_ERROR: Call Dev_LogError(Err.Number, Err.Description) End Function Public Function t_FindFormat() On Error GoTo PROPAGATE_ERROR Call config_.Load(SetupTestConfig) Dim iDoc As Word.Document: Set iDoc = wordApp_.NewDocument(config_.sourcePath_) Dim iFormat As New InfoFormat Call Dev_NewCase("Empty format") Call Dev_ExpectNothing(config_.FindFormat(iFormat, iDoc)) Call Dev_NewCase("Valid find") Call config_.AddBasicCategory("TestIncomplete") Dim iCat As InfoCategory: Set iCat = config_.categories_(1) Call Dev_ExpectEQ(iCat, config_.FindFormat(iCat.GetFormat(iDoc), iDoc)) Call wordApp_.ReleaseDocument(bCloseApplication:=False, bSaveChanges:=False) Exit Function PROPAGATE_ERROR: Call Dev_LogError(Err.Number, Err.Description) End Function Public Function t_AssignStyle() On Error GoTo PROPAGATE_ERROR Dim iDoc As Word.Document: Set iDoc = wordApp_.NewDocument() Call Dev_NewCase("Empty config") Call Dev_ExpectFalse(config_.AssignStyle(1, iDoc.Styles(wdStyleNormal), iDoc)) Call Dev_NewCase("Valid config - errors") Call config_.Load(SetupTestConfig) Call config_.SyncStyles(iDoc.Application, iDoc.FullName) Dim iStyle1 As Word.Style: Set iStyle1 = iDoc.Styles("Style1") Call Dev_ExpectFalse(config_.AssignStyle(1337, iStyle1, iDoc), "Invalid id") Call Dev_ExpectFalse(config_.AssignStyle(1, iStyle1, iDoc), "Style already assigned") On Error Resume Next Call Dev_ExpectFalse(config_.AssignStyle(2, iStyle1, iDoc), "Style is taken") Call Dev_ExpectError(ERR_STYLE_TAKEN, "Style is taken") On Error GoTo PROPAGATE_ERROR On Error Resume Next Call Dev_ExpectFalse(config_.AssignStyle(1, iDoc.Styles(wdStyleNormal), iDoc), "Invalid style") Call Dev_ExpectError(ERR_STYLE_NO_FORMAT, "Invalid style") On Error GoTo PROPAGATE_ERROR Dim iStyleNew As Word.Style: Set iStyleNew = iDoc.Styles.Add("StyleNew", wdStyleTypeCharacter) iStyleNew.Font.Italic = True iStyleNew.Font.Bold = True On Error Resume Next Call Dev_ExpectFalse(config_.AssignStyle(1, iStyleNew, iDoc), "Format taken") Call Dev_ExpectError(ERR_FORMAT_TAKEN, "Format taken") On Error GoTo PROPAGATE_ERROR Call Dev_NewCase("Valid config - assign style") iStyleNew.Font.Underline = wdUnderlineDouble Call Dev_ExpectTrue(config_.AssignStyle(1, iStyleNew, iDoc)) Call Dev_ExpectTrue(config_.AssignStyle(2, iStyle1, iDoc), "Reassign old style") Call wordApp_.ReleaseDocument(bCloseApplication:=False, bSaveChanges:=False) Set iDoc = wordApp_.OpenDocument(config_.sourcePath_) Call Dev_ExpectTrue(WordStyleExists(iDoc, "StyleNew"), "Add style to config") Call wordApp_.ReleaseDocument(bCloseApplication:=False, bSaveChanges:=False) Exit Function PROPAGATE_ERROR: Call Dev_LogError(Err.Number, Err.Description) End Function