REM ***** BASIC ***** const cMaxErrorStates = 13 const cCoGreen = 4057917, cCoRed = 16711680, cCoGrey = 12632256 const cParagraphBreak = 0 global const cExtensionFileName = "TestExtension.oxt" global const cDocNew = 0, cDocCut = 1, cDocPaste = 2, cDocSaveOpen8 = 3, cDocSaveOpenXML = 4, cDocSaveOpen50 = 5, cDocClose = 6, cDocWrite = 7 global const cDBService = 0, cDBOpen = 1, cDBInsert = 2, cDBDelete = 3, cDBSeek = 4, cDBClose = 5 global const cEXTService = 0, cEXTInstall = 1, cEXTUninstall = 2 global const cLogfileFailed = 255 global const cStWriter = 0, cStCalc = 1, cStPraesentation = 2, cStZeichnen = 3 global const cStMessage = 12, cStHTML = 6, cStChart = 4, cStJava = 7 global const cStMath = 5, cStDataBase = 9 global const cStExtension = 11 global const cStNone = -1 global const cFlt8 = 0, cFlt50 = 32, cFltNewDoc = 64, cFltXML = 128 global const frmWriter = 1, frmCalc = 2, frmMessage = 3, frmImpress = 4 global const frmMath = 5, frmImage = 6, frmChart = 7, frmHyperText = 8, frmDraw = 9 global const frmDataBase = 10, frmJava = 13 global const frmExtension = 14 global const cLogUnknown = 0, cLogFalse = 1, cLogTrue = 2 'UserFieldKennungen Global const cYes = "y", cNo = "n" Global const cStateNo = 0, cStateYes = 1 'Feldtypen Global const cFtExtUser = 21, cFtPageNum = 5, cFtStatistic = 8, cFtDateTime = 27, cFtDatabase = 31 'UnoStrings Global const cUnoSeparator = "." Global const cUnoPrefix = "com.sun.star." Global const cUnoUserField = cUnoPrefix + "text.FieldMaster.User" Global const cUnoExtUserField = cUnoPrefix + "text.TextField.ExtendedUser" Global const cUnoMasterDataBase = cUnoPrefix + "text.FieldMaster.Database" Global const cUnoDataBase = cUnoPrefix + "text.TextField.Database" Global const cUnoDateTime = cUnoPrefix + "text.TextField.DateTime" Global const cUnoTextGraphi2 = cUnoPrefix + "text.Graphic" Global const cUnoJavaLoader = cUnoPrefix + "loader.Java" Global const cUnoDatabaseContext = cUnoPrefix + "sdb.DatabaseContext" Global const cUnoRowSet = cUnoPrefix + "sdb.RowSet" Global const cUnoSmoketestTestExtension = cUnoPrefix + "comp.smoketest.TestExtension" Global const cUnoSmoketestCommandEnvironment = cUnoPrefix + "deployment.test.SmoketestCommandEnvironment" Global const cExtensionManager = cUnoPrefix + "deployment.ExtensionManager" 'UserFieldNames Global const cUserFieldTestWriter = "Writer", cUserFieldTestCalc = "Calc", cUserFieldTestImpress = "Impress" Global const cUserFieldTestDraw = "Draw", cUserFieldTestMath = "Math", cUserFieldTestChart = "Chart" Global const cUserFieldTestHTML = "HTML", cUserFieldTestJava = "Java", cUserFieldTestDatabase = "Database" Global const cUserFieldTestExtension = "Extension" Global const cUserFieldTestOpenSaveXML = "SaveOpenXML", cUserFieldTestOpenSave50 = "SaveOpen50", cUserFieldTestCut = "Cut" Global const cUserFieldTestPaste = "Paste", cUserFieldTestTerminateAfterTest = "Terminate", cUserFieldTestOpenSave8 = "SaveOpen8" Global const cOptionsDialogName = "OptionsDlg", cTest10Modul = "Standard" Global const cDlgCancel = 1, cDlgOk = 0, cDlgStartTest = 2 global gErrorState (cMaxErrorStates, 5) as integer global gOutputDoc as Object global gOutputDocNotUno as Object global gOptionsDialog as Object Global bMakeWriterTest as boolean, bMakeCalcTest as boolean, bMakeImpressTest as boolean Global bMakeDrawTest as Boolean, bMakeMathTest as boolean, bMakeChartTest as boolean Global bMakeHTMLTest as boolean, bMakeJavaTest as boolean, bMakeDBTest as boolean Global bMakeExtensionTest as boolean Global bMakeSaveOpenXMLTest as boolean, bMakeSaveOpen50Test as boolean, bMakeCutTest as boolean Global bMakePasteTest as boolean, bMakeTerminateAfterTest as boolean, bShowTable as boolean Global bMakeSaveOpen8Test as boolean global sExtensionURL as string Dim gDlgState as Integer Sub SetGlobalDoc gOutPutDoc = ThisComponent end Sub Sub ClearStatus for j% = 0 to cMaxErrorStates for i% = 0 to 5 gErrorState (j%, i%) = cLogUnknown next i% next j% end Sub Sub ClearAllText call SetGlobalDoc call ClearDoc (gOutPutDoc) call ClearStatus end Sub Sub Main call SetGlobalDoc if bShowTable then call ClearDoc (gOutPutDoc) end If call ClearStatus Call Test_10er.Main if bShowTable then call CreateStatusTable2 call CreateStatusTable call CreateDocState call CreateSecondState gOutputDoc.CurrentController.ViewCursor.JumpToFirstPage end if End Sub Sub CreateStatusTable dim tableHeaders(7) as string tableHeaders(cStWriter) = "Writer" tableHeaders(cStCalc) = "Calc" tableHeaders(cStPraesentation) = "Präsen- tation" tableHeaders(cStZeichnen) = "Zeichn." tableHeaders(cStChart) = "Diagr." tableHeaders(cStMath) = "Math" tableHeaders(cStHTML) = "HTML" tableHeaders(cStJava) = "Java" dim tableColums(5) as string tableColums(cDocNew) = "new" tableColums(cDocCut) = "cut" tableColums(cDocPaste) = "paste" tableColums(cDocSaveOpen8) = "V8.0" tableColums(cDocSaveOpenXML) = "XML" tableColums(cDocSaveOpen50) = "V5.0" ' tableColums(cDocClose) = "close" aDoc = gOutPutDoc xText = aDoc.Text xCursor = xText.createTextCursor() ' xCursor.gotoStart(FALSE) ' xCursor.GoRight (2, False) ' SetParagraphBreak (xCursor) ' SetParagraphBreak (xCursor) xCursor.gotoStart(FALSE) xCursor.GoRight (4, False) SetParagraphBreak (xCursor) xCursor.GoRight (1, False) SetParagraphBreak (xCursor) xCursor.GoRight (1, False) table = aDoc.createInstance("com.sun.star.text.TextTable") table.initialize(7,9) table.Name = "StTab1" xText.insertTextContent(xCursor, table, FALSE) tableCursor = table.createCursorByCellName(table.CellNames(0)) tableCursor.gotoStart(FALSE) tableCursor.goRight(1,FALSE) for i% = 0 to 7 cName = tableCursor.getRangeName() xCell = table.getCellByName(cName) xCell.String=tableHeaders(i%) xCell.BackTransparent = False xCell.BackColor = cCoGrey tableCursor.goRight(1,FALSE) next i% xCursor.gotoStart(FALSE) ' SetParagraphBreak (xCursor) ' SetParagraphBreak (xCursor) tableCursor.gotoStart(FALSE) cName = tableCursor.getRangeName() xCell = table.getCellByName(cName) xCell.BackTransparent = False xCell.BackColor = cCoGrey for i% = 0 to 5 tableCursor.goDown(1,FALSE) cName = tableCursor.getRangeName() xCell = table.getCellByName(cName) xCell.String=tableColums(i%) xCell.BackTransparent = False xCell.BackColor = cCoGrey next i% end Sub Sub CreateStatusTable2 dim tableHeaders(5) as string tableHeaders(cStDataBase-9) = "Database" tableHeaders(1) = "" tableHeaders(cStExtension-9) = "Extension" tableHeaders(3) = "" tableHeaders(4) = "" dim tableColums(5) as string tableColums(cDBService ) = "services" tableColums(cDBOpen ) = "open" tableColums(cDBInsert ) = "insert" tableColums(cDBDelete ) = "delete" tableColums(cDBSeek ) = "seek" tableColums(cDBClose ) = "close" dim tableColums2(3) as string tableColums2(cEXTService ) = "services" tableColums2(cEXTInstall ) = "install" tableColums2(cEXTUninstall ) = "uninstall" aDoc = gOutPutDoc xText = aDoc.Text xCursor = xText.createTextCursor() xCursor.gotoStart(FALSE) xCursor.GoRight (4, False) SetParagraphBreak (xCursor) SetParagraphBreak (xCursor) xCursor.gotoEnd(FALSE) table = aDoc.createInstance("com.sun.star.text.TextTable") table.initialize(7,6) table.Name = "StTab2" 'table.RelativeWidth =500 xText.insertTextContent(xCursor, table, FALSE) tableCursor = table.createCursorByCellName(table.CellNames(0)) tableCursor.gotoStart(FALSE) tableCursor.goRight(1,FALSE) for i% = 0 to 5 cName = tableCursor.getRangeName() xCell = table.getCellByName(cName) xCell.String=tableHeaders(i%) xCell.BackTransparent = False xCell.BackColor = cCoGrey tableCursor.goRight(1,FALSE) next i% tableCursor.gotoStart(FALSE) cName = tableCursor.getRangeName() xCell = table.getCellByName(cName) xCell.BackTransparent = False xCell.BackColor = cCoGrey for i% = 0 to 5 tableCursor.goDown(1,FALSE) cName = tableCursor.getRangeName() xCell = table.getCellByName(cName) xCell.String=tableColums(i%) xCell.BackTransparent = False xCell.BackColor = cCoGrey next i% tableCursor.gotoStart(FALSE) tableCursor.goRight(2,FALSE) for i% = 0 to 3 tableCursor.goDown(1,FALSE) cName = tableCursor.getRangeName() xCell = table.getCellByName(cName) xCell.String=tableColums2(i%) xCell.BackTransparent = False xCell.BackColor = cCoGrey next i% end Sub Sub CreateDocState aDoc = gOutPutDoc table = aDoc.TextTables.GetByIndex (1) 'table = aDoc.TextTables.GetByName ("StTab1") for j% = 0 to 7 for i% = 0 to 5 sRangeName = GetRangeName(j%, i%+1) tableCursor = table.createCursorByCellName(sRangeName) cName = tableCursor.getRangeName() xCell = table.getCellByName(cName) xCell.BackTransparent = False if gErrorState (j%, i%) = cLogTrue then xCell.BackColor = cCoGreen else if gErrorState (j%, i%) = cLogFalse then xCell.BackColor = cCoRed else xCell.BackColor = cCoGrey end If end If next i% next j% end Sub Sub CreateSecondState aDoc = gOutPutDoc table = aDoc.TextTables.GetByIndex (0) 'table = aDoc.TextTables.GetByName ("StTab2") for j% = 0 to cMaxErrorStates-9 for i% = 0 to 5 sRangeName = GetRangeName(j%, i%+1) tableCursor = table.createCursorByCellName(sRangeName) cName = tableCursor.getRangeName() xCell = table.getCellByName(cName) xCell.BackTransparent = False if gErrorState (j%+9, i%) = cLogTrue then xCell.BackColor = cCoGreen else if gErrorState (j%+9, i%) = cLogFalse then xCell.BackColor = cCoRed else xCell.BackColor = cCoGrey end If end If next i% next j% end Sub Function GetRangeName (nColumn as integer, nRow as integer) as string GetRangeName = chr (nColumn+66) + Trim(Str(nRow+1)) end Function Sub SetStatus (nDocType as Integer, nAction as Integer, bState as Boolean) Dim nStatusType as Integer Dim nState as integer nStatusType = GetStatusType (nDocType) If nStatusType = cStNone then Exit Sub if bState then nState = cLogTrue else nState = cLogFalse end If gErrorState (nStatusType, nAction) = nState end Sub Function GetStatusType (nDocType as Integer) as Integer Select Case ( nDocType ) case frmWriter GetStatusType = cStWriter ' Textdokument case frmCalc GetStatusType = cStCalc 'Tabellendokument case frmMessage GetStatusType = cStMessage 'Nachricht case frmImpress GetStatusType = cStPraesentation 'Präsentation case frmDraw GetStatusType = cStZeichnen 'Zeichnen case frmMath GetStatusType = cStMath 'Formel case frmImage GetStatusType = cStBild 'Bild case frmHyperText GetStatusType = cStHTML 'Hypertext-Dokument case frmChart GetStatusType = cStChart 'Diagramm case frmJava GetStatusType = cStJava 'Java case frmDataBase GetStatusType = cStDataBase 'DataBase case frmExtension GetStatusType = cStExtension 'Extension case else GetStatusType = cStNone end Select end Function Sub SetParagraphBreak (aCursor as Object) aCursor.Text.InsertControlCharacter (aCursor, cParagraphBreak, True) end Sub Sub ClearDoc (aDoc as Object) Dim aText as Object Dim i% for i%=1 to aDoc.TextTables.count aDoc.TextTables.GetByIndex(0).dispose next aText = aDoc.Text.CreateTextCursor aText.GotoStart (False) aText.GoRight (3, False) SetParagraphBreak (aText) aText.GotoEnd (True) aText.String="" end Sub Sub ClearDocFull (aDoc as Object) Dim aText as Object Dim i% for i%=1 to aDoc.TextTables.count aDoc.TextTables.GetByIndex(0).dispose next aText = aDoc.Text.CreateTextCursor aText.GotoStart (False) aText.GotoEnd (True) aText.String="" end Sub Sub SetGlobalOptionsDialog () Dim oLibContainer As Object, oLib As Object Dim oInputStreamProvider As Object Dim oDialog As Object Const sLibName = cTest10Modul Const sDialogName = cOptionsDialogName REM get library and input stream provider oLibContainer = DialogLibraries REM load the library oLibContainer.loadLibrary( sLibName ) oLib = oLibContainer.getByName( sLibName ) oInputStreamProvider = oLib.getByName( sDialogName ) REM create dialog control gOptionsDialog = CreateUnoDialog( oInputStreamProvider ) end Sub Sub ShowOptionsDlg call SetGlobalDoc call SetGlobalOptionsDialog call GetOptions REM show the dialog gOptionsDialog.execute() ' jetzt läuft der Dialog, bis ein Button gedrückt wird Select Case (gDlgState) case cDlgOk call SetOptions () case cDlgStartTest call SetOptions () call StartTestByOptions () end Select gOptionsDialog.dispose() end Sub Sub SetOptions call SetGlobalDoc SetUserFieldState (cUserFieldTestWriter, -(gOptionsDialog.getControl("cbWriterTest").getState), gOutPutDoc) SetUserFieldState (cUserFieldTestCalc, -(gOptionsDialog.getControl("cbCalcTest").getState), gOutPutDoc) SetUserFieldState (cUserFieldTestImpress, -(gOptionsDialog.getControl("cbImpressTest").getState), gOutPutDoc) SetUserFieldState (cUserFieldTestDraw, -(gOptionsDialog.getControl("cbDrawTest").getState), gOutPutDoc) SetUserFieldState (cUserFieldTestHTML, -(gOptionsDialog.getControl("cbHTMLTest").getState), gOutPutDoc) SetUserFieldState (cUserFieldTestMath, -(gOptionsDialog.getControl("cbMathTest").getState), gOutPutDoc) SetUserFieldState (cUserFieldTestChart, -(gOptionsDialog.getControl("cbChartTest").getState), gOutPutDoc) SetUserFieldState (cUserFieldTestJava, -(gOptionsDialog.getControl("cbJavaTest").getState), gOutPutDoc) SetUserFieldState (cUserFieldTestDatabase, -(gOptionsDialog.getControl("cbDatabaseTest").getState), gOutPutDoc) SetUserFieldState (cUserFieldTestExtension, -(gOptionsDialog.getControl("cbExtensionTest").getState), gOutPutDoc) SetUserFieldState (cUserFieldTestOpenSaveXML, -(gOptionsDialog.getControl("cbSaveOpenXMLTest").getState), gOutPutDoc) SetUserFieldState (cUserFieldTestOpenSave50, -(gOptionsDialog.getControl("cbSaveOpen50Test").getState), gOutPutDoc) SetUserFieldState (cUserFieldTestOpenSave8, -(gOptionsDialog.getControl("cbSaveOpen8Test").getState), gOutPutDoc) SetUserFieldState (cUserFieldTestCut, -(gOptionsDialog.getControl("cbCutTest").getState), gOutPutDoc) SetUserFieldState (cUserFieldTestPaste, -(gOptionsDialog.getControl("cbPasteTest").getState), gOutPutDoc) SetUserFieldState (cUserFieldTestTerminateAfterTest, -(gOptionsDialog.getControl("cbTerminateAfterTest").getState), gOutPutDoc) end Sub Sub GetOptions call SetGlobalDoc gOptionsDialog.getControl("cbWriterTest").setState( -( GetUserFieldState (cUserFieldTestWriter, gOutPutDoc))) gOptionsDialog.getControl("cbCalcTest").setState ( -( GetUserFieldState (cUserFieldTestCalc, gOutPutDoc))) gOptionsDialog.getControl("cbImpressTest").setState( -( GetUserFieldState (cUserFieldTestImpress, gOutPutDoc))) gOptionsDialog.getControl("cbDrawTest").setState( -( GetUserFieldState (cUserFieldTestDraw, gOutPutDoc))) gOptionsDialog.getControl("cbHTMLTest").setState( -( GetUserFieldState (cUserFieldTestHTML, gOutPutDoc))) gOptionsDialog.getControl("cbMathTest").setState( -( GetUserFieldState (cUserFieldTestMath, gOutPutDoc))) gOptionsDialog.getControl("cbChartTest").setState( -( GetUserFieldState (cUserFieldTestChart, gOutPutDoc))) gOptionsDialog.getControl("cbJavaTest").setState( -( GetUserFieldState (cUserFieldTestJava, gOutPutDoc))) gOptionsDialog.getControl("cbDatabaseTest").setState( -( GetUserFieldState (cUserFieldTestDatabase, gOutPutDoc))) gOptionsDialog.getControl("cbExtensionTest").setState( -( GetUserFieldState (cUserFieldTestExtension, gOutPutDoc))) gOptionsDialog.getControl("cbSaveOpenXMLTest").setState( -( GetUserFieldState (cUserFieldTestOpenSaveXML, gOutPutDoc))) gOptionsDialog.getControl("cbSaveOpen50Test").setState( -( GetUserFieldState (cUserFieldTestOpenSave50, gOutPutDoc))) gOptionsDialog.getControl("cbSaveOpen8Test").setState( -( GetUserFieldState (cUserFieldTestOpenSave8, gOutPutDoc))) gOptionsDialog.getControl("cbCutTest").setState( -( GetUserFieldState (cUserFieldTestCut, gOutPutDoc))) gOptionsDialog.getControl("cbPasteTest").setState( -( GetUserFieldState (cUserFieldTestPaste, gOutPutDoc))) gOptionsDialog.getControl("cbTerminateAfterTest").setState( -( GetUserFieldState (cUserFieldTestTerminateAfterTest, gOutPutDoc))) End Sub Sub ReadOptions call SetGlobalDoc bMakeWriterTest = GetUserFieldState (cUserFieldTestWriter, gOutPutDoc) bMakeCalcTest = GetUserFieldState (cUserFieldTestCalc, gOutPutDoc) bMakeImpressTest = GetUserFieldState (cUserFieldTestImpress, gOutPutDoc) bMakeDrawTest = GetUserFieldState (cUserFieldTestDraw, gOutPutDoc) bMakeHTMLTest = GetUserFieldState (cUserFieldTestHTML, gOutPutDoc) bMakeMathTest = GetUserFieldState (cUserFieldTestMath, gOutPutDoc) bMakeChartTest = GetUserFieldState (cUserFieldTestChart, gOutPutDoc) bMakeJavaTest = GetUserFieldState (cUserFieldTestJava, gOutPutDoc) bMakeDBTest = GetUserFieldState (cUserFieldTestDatabase, gOutPutDoc) bMakeExtensionTest = GetUserFieldState (cUserFieldTestExtension, gOutPutDoc) bMakeSaveOpenXMLTest = GetUserFieldState (cUserFieldTestOpenSaveXML, gOutPutDoc) bMakeSaveOpen50Test = GetUserFieldState (cUserFieldTestOpenSave50, gOutPutDoc) bMakeSaveOpen8Test = GetUserFieldState (cUserFieldTestOpenSave8, gOutPutDoc) bMakeCutTest = GetUserFieldState (cUserFieldTestCut, gOutPutDoc) bMakePasteTest = GetUserFieldState (cUserFieldTestPaste, gOutPutDoc) bMakeTerminateAfterTest = GetUserFieldState (cUserFieldTestTerminateAfterTest, gOutPutDoc) end Sub Sub SetDefaultOptions bMakeWriterTest = true bMakeCalcTest = true bMakeImpressTest = true bMakeDrawTest = true bMakeHTMLTest = true bMakeMathTest = true bMakeChartTest = true if Environ("SOLAR_JAVA") = "" then bMakeJavaTest = false bMakeDBTest = false bMakeExtensionTest = false else bMakeJavaTest = true bMakeDBTest = true bMakeExtensionTest = true End If bMakeSaveOpenXMLTest = true REM Disable StarOffice 5.0 tests in case binfilter has not been included if Environ("WITH_BINFILTER") = "NO" then bMakeSaveOpen50Test = false else bMakeSaveOpen50Test = true End If bMakeSaveOpen8Test = true bMakeCutTest = true bMakePasteTest = true bMakeTerminateAfterTest = false end Sub Sub StartTestByOptions bShowTable = true call ReadOptions call Main if bMakeTerminateAfterTest then ClearDocFull (gOutPutDoc) gOutPutDoc.dispose 'StarDesktop.Terminate 'EnableReschedule( false ) 'DispatchSlot( 5300 ) stop End If end Sub Function StartTestWithDefaultOptions bShowTable = false call SetDefaultOptions call Main dim component(cMaxErrorStates) as string component(cStWriter) = "Writer" component(cStCalc) = "Calc" component(cStPraesentation) = "Impress" component(cStZeichnen) = "Draw" component(cStChart) = "Chart" component(cStMath) = "Math" component(cStHTML) = "HTML" component(cStJava) = "Java" component(cStDataBase) = "Base" component(cStExtension) = "Extensions" dim action(5) as string action(cDocNew) = "new" action(cDocCut) = "cut" action(cDocPaste) = "paste" action(cDocSaveOpen8) = "V8.0" action(cDocSaveOpenXML) = "XML" action(cDocSaveOpen50) = "V5.0" dim baseAction(5) as string baseAction(cDBService) = "services" baseAction(cDBOpen) = "open" baseAction(cDBInsert) = "insert" baseAction(cDBDelete) = "delete" baseAction(cDBSeek) = "seek" baseAction(cDBClose) = "close" dim extAction(2) as string extAction(cEXTService) = "services" extAction(cEXTInstall) = "install" extAction(cEXTUninstall) = "uninstall" dim result as string for i = 0 to cMaxErrorStates for j = 0 to 5 if gErrorState(i, j) = cLogFalse then result = result & " " & component(i) & ":" if i = cStDataBase then result = result & baseAction(j) else if i = cStExtension then result = result & extAction(j) else result = result & action(j) end if end if end if next j next i StartTestWithDefaultOptions = result end Function Sub DispatchSlot(SlotID as Integer) Dim oArg() as new com.sun.star.beans.PropertyValue Dim oUrl as new com.sun.star.util.URL Dim oTrans as Object Dim oDisp as Object oTrans = createUNOService("com.sun.star.util.URLTransformer") oUrl.Complete = "slot:" & CStr(SlotID) oTrans.parsestrict(oUrl) oDisp = StarDesktop.queryDispatch(oUrl, "_self", 0) oDisp.dispatch(oUrl, oArg()) End Sub Sub LoadLibrary( LibName As String ) dim args(1) dim arg as new com.sun.star.beans.PropertyValue arg.Name = "LibraryName" arg.Value = LibName args(0) = arg dim url as new com.sun.star.util.URL dim trans as object trans = createUnoService("com.sun.star.util.URLTransformer" ) url.Complete = "slot:6517" trans.parsestrict( url ) dim disp as object disp = StarDesktop.currentFrame.queryDispatch( url, "", 0 ) disp.dispatch( url, args() ) End Sub Sub ExecuteSlot( SlotNr As String, oDoc as Object ) dim args() dim url as new com.sun.star.util.URL dim trans as object dim disp as object trans = createUnoService("com.sun.star.util.URLTransformer" ) url.Complete = "slot:" + SlotNr trans.parsestrict( url ) disp = oDoc.CurrentController.Frame.queryDispatch( url, "", 0 ) disp.dispatch( url, args() ) End Sub Sub CutText (oDoc as Object) ExecuteSlot ("5710", oDoc) End Sub Sub PasteText (oDoc as Object) ExecuteSlot ("5712", oDoc) End Sub Sub DelAllUserFields (aDoc as Object) Dim aFieldType as Object Dim aElements as Variant Dim i% Dim aFieldMasters, aFieldMaster as Object Dim sElement$ aFieldMasters = aDoc.TextFieldMasters aElements = aFieldMasters.ElementNames for i = 0 to UBound(aElements) sElement$ = aElements(i) if 0 <> instr(sElement$, cUnoUserField ) then aFieldMaster = aFieldMasters.GetByName(sElement$) aFieldMaster.Dispose endif next end Sub Function GetUserFieldState (sName as String, aDoc as Object) as boolean Dim sFieldText as String Dim bState as boolean sFieldText = ReadUserField (sName, aDoc) if LCase(sFieldText) = cYes then bState = true else bState = false end IF GetUserFieldState = bState end Function Sub SetUserFieldState (sName as String, nState as boolean, aDoc as Object) Dim sFieldText as String sFieldText = cNo 'default Select case nState case true sFieldText = cYes case false sFieldText = cNo end Select WriteUserField (sFieldText, sName, aDoc) end Sub Function ReadUserField(sFieldName as String, aDoc as Object) as String Dim aMasters as Object aMasters = aDoc.TextFieldMasters if aMasters.HasByName (cUnoUserField+cUnoSeparator+sFieldName) then ReadUserField = aMasters.GetByName (cUnoUserField+cUnoSeparator+sFieldName).Content else ReadUserField = "" end If End Function Sub WriteUserField(sValue as String, sFieldName as String, aDoc as Object, optional aCursor as Object) Dim aMasters, aUserField, aTxtCursor as Object aMasters = aDoc.TextFieldMasters if aMasters.HasByName (cUnoUserField+cUnoSeparator+sFieldName) then aUserField = aMasters.GetByName (cUnoUserField+cUnoSeparator+sFieldName) else aUserField = aDoc.CreateInstance (cUnoUserField) aUserField.Name = sFieldName end if aUserField.Content = sValue End Sub Sub WriteExtUserField(nIndex as Integer, aCursor as Object, aDoc as Object) Dim aUserField as Object aUserField = aDoc.CreateInstance (cUnoExtUserField) aUserField.UserDataType = nIndex aCursor.Text.InsertTextContent (aCursor, aUserField, True) aUserField.Fix = True End Sub