REM ***** BASIC ***** Sub ActivateReadOnlyFlag() SetBasicReadOnlyFlag(True) End Sub Sub DeactivateReadOnlyFlag() SetBasicReadOnlyFlag(False) End Sub Sub SetBasicReadOnlyFlag(bReadOnly as Boolean) Dim i as Integer Dim LibName as String Dim BasicLibNames() as String BasicLibNames() = BasicLibraries.ElementNames() For i = 0 To Ubound(BasicLibNames()) LibName = BasicLibNames(i) If LibName <> "Standard" Then BasicLibraries.SetLibraryReadOnly(LibName, bReadOnly) End If Next i End Sub Sub WritedbgInfo(LocObject as Object) Dim locUrl as String Dim oLocDocument as Object Dim oLocText as Object Dim oLocCursor as Object Dim NoArgs() Dim sObjectStrings(2) as String Dim sProperties() as String Dim n as Integer Dim m as Integer Dim MaxIndex as Integer sObjectStrings(0) = LocObject.dbg_Properties sObjectStrings(1) = LocObject.dbg_Methods sObjectStrings(2) = LocObject.dbg_SupportedInterfaces LocUrl = "private:factory/swriter" oLocDocument = StarDesktop.LoadComponentFromURL(LocUrl,"_blank",0,NoArgs) oLocText = oLocDocument.text oLocCursor = oLocText.createTextCursor() oLocCursor.gotoStart(False) If Vartype(LocObject) = 9 then ' an Object Variable For n = 0 To 2 sProperties() = ArrayoutofString(sObjectStrings(n),";", MaxIndex) For m = 0 To MaxIndex oLocText.insertString(oLocCursor,sProperties(m),False) oLocText.insertControlCharacter(oLocCursor,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False) Next m Next n Elseif Vartype(LocObject) = 8 Then ' a String Variable oLocText.insertString(oLocCursor,LocObject,False) ElseIf Vartype(LocObject) = 1 Then Msgbox("Variable is Null!", 16, GetProductName()) End If End Sub Sub WriteDbgString(LocString as string) Dim oLocDesktop as object Dim LocUrl as String Dim oLocDocument as Object Dim oLocCursor as Object Dim oLocText as Object LocUrl = "private:factory/swriter" oLocDocument = StarDesktop.LoadComponentFromURL(LocUrl,"_blank",0,NoArgs) oLocText = oLocDocument.text oLocCursor = oLocText.createTextCursor() oLocCursor.gotoStart(False) oLocText.insertString(oLocCursor,LocString,False) End Sub Sub printdbgInfo(LocObject) If Vartype(LocObject) = 9 then Msgbox LocObject.dbg_properties Msgbox LocObject.dbg_methods Msgbox LocObject.dbg_supportedinterfaces Elseif Vartype(LocObject) = 8 Then ' a String Variable Msgbox LocObject ElseIf Vartype(LocObject) = 0 Then Msgbox("Variable is Null!", 16, GetProductName()) Else Msgbox("Type of Variable: " & Typename(LocObject), 48, GetProductName()) End If End Sub Sub ShowArray(LocArray()) Dim i as integer Dim msgstring msgstring = "" For i = Lbound(LocArray()) to Ubound(LocArray()) msgstring = msgstring + LocArray(i) + chr(13) Next Msgbox msgstring End Sub Sub ShowPropertyValues(oLocObject as Object) Dim PropName as String Dim sValues as String On Local Error Goto NOPROPERTYSETINFO: sValues = "" For i = 0 To Ubound(oLocObject.PropertySetInfo.Properties) Propname = oLocObject.PropertySetInfo.Properties(i).Name sValues = sValues & PropName & chr(13) & " = " & oLocObject.GetPropertyValue(PropName) & chr(13) Next i Msgbox(sValues , 64, GetProductName()) Exit Sub NOPROPERTYSETINFO: Msgbox("Sorry, No PropertySetInfo attached to the object", 16, GetProductName()) Resume LEAVEPROC LEAVEPROC: End Sub Sub ShowNameValuePair(Pair()) Dim i as Integer Dim ShowString as String ShowString = "" On Local Error Resume Next For i = 0 To Ubound(Pair()) ShowString = ShowString & Pair(i).Name & " = " ShowString = ShowString & Pair(i).Value & chr(13) Next i Msgbox ShowString End Sub ' Retrieves all the Elements of aSequence of an object, with the ' possibility to define a filter(sfilter <> "") Sub ShowElementNames(oLocElements() as Object, Optional sFiltername as String) Dim i as Integer Dim NameString as String NameString = "" For i = 0 To Ubound(oLocElements()) If Not IsMissIng(sFilterName) Then If Instr(1, oLocElements(i), sFilterName) Then NameString = NameString & oLocElements(i) & chr(13) End If Else NameString = NameString & oLocElements(i) & chr(13) End If Next i Msgbox(NameString, 64, GetProductName()) End Sub ' Retrieves all the supported servicenames of an object, with the ' possibility to define a filter(sfilter <> "") Sub ShowSupportedServiceNames(oLocObject as Object, Optional sFilterName as String) On Local Error Goto NOSERVICENAMES If IsMissing(sFilterName) Then ShowElementNames(oLocobject.SupportedServiceNames()) Else ShowElementNames(oLocobject.SupportedServiceNames(), sFilterName) End If Exit Sub NOSERVICENAMES: Msgbox("Sorry, No 'SupportedServiceNames' - Property attached to the object", 16, GetProductName()) Resume LEAVEPROC LEAVEPROC: End Sub ' Retrieves all the available Servicenames of an object, with the ' possibility to define a filter(sfilter <> "") Sub ShowAvailableServiceNames(oLocObject as Object, Optional sFilterName as String) On Local Error Goto NOSERVICENAMES If IsMissing(sFilterName) Then ShowElementNames(oLocobject.AvailableServiceNames) Else ShowElementNames(oLocobject.AvailableServiceNames, sFilterName) End If Exit Sub NOSERVICENAMES: Msgbox("Sorry, No 'AvailableServiceNames' - Property attached to the object", 16, GetProductName()) Resume LEAVEPROC LEAVEPROC: End Sub Sub ShowCommands(oLocObject as Object) On Local Error Goto NOCOMMANDS ShowElementNames(oLocObject.QueryCommands) Exit Sub NOCOMMANDS: Msgbox("Sorry, No 'QueryCommands' - Property attached to the object", 16, GetProductName()) Resume LEAVEPROC LEAVEPROC: End Sub Sub ProtectCurrentSheets() Dim oDocument as Object Dim sDocType as String Dim iResult as Integer Dim oSheets as Object Dim i as Integer Dim bDoProtect as Boolean oDocument = StarDesktop.ActiveFrame.Controller.Model sDocType = GetDocumentType(oDocument) If sDocType = "scalc" Then oSheets = oDocument.Sheets bDoProtect = False For i = 0 To oSheets.Count-1 If Not oSheets(i).IsProtected Then bDoProtect = True End If Next i If bDoProtect Then iResult = Msgbox( "Do you want to protect all sheets of this document?",35, GetProductName()) If iResult = 6 Then ProtectSheets(oDocument.Sheets) End If End If End If End Sub Sub FillDocument() oMyReport = createUNOService("com.sun.star.wizards.report.CallReportWizard") oMyReport.trigger("fill") End Sub