DOS/V Power Report 2004 April/VPR0404.ISO/OPENOFFICE/INSTALL/f_0220/Debug.xba

Extensible Markup Language | 2002-10-16 | 7KB | 236 lines

<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Debug" script:language="StarBasic">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,"_default",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,"_default",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

</script:module>