com!online 2001 December/COMCD1201.iso/openoffice/f_0179/Debug.xba

Extensible Markup Language | 2001-06-06 | 5.7 KB | 176 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 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
    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</script:module>