office-gobmx/wizards/source/tools/Debug.xba

180 lines
5.5 KiB
Text
Raw Normal View History

2001-05-04 09:15:07 -05:00
<?xml version="1.0" encoding="UTF-8"?>
<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 = &quot;private:factory/swriter&quot;
oLocDocument = StarDesktop.LoadComponentFromURL(LocUrl,&quot;_blank&quot;,0,NoArgs)
oLocText = oLocDocument.text
oLocCursor = oLocText.createTextCursor()
oLocCursor.gotoStart(False)
If Vartype(LocObject) = 9 then &apos; an Object Variable
For n = 0 To 2
sProperties() = ArrayoutofString(sObjectStrings(n),&quot;;&quot;, 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 &apos; a String Variable
oLocText.insertString(oLocCursor,LocObject,False)
ElseIf Vartype(LocObject) = 1 Then
Msgbox(&quot;Variable is Null!&quot;, 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 = &quot;private:factory/swriter&quot;
oLocDocument = StarDesktop.LoadComponentFromURL(LocUrl,&quot;_blank&quot;,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 &apos; a String Variable
Msgbox LocObject
ElseIf Vartype(LocObject) = 0 Then
Msgbox(&quot;Variable is Null!&quot;, 16, GetProductName())
Else
Msgbox(&quot;Type of Variable: &quot; &amp; Typename(LocObject), 48, GetProductName())
End If
End Sub
Sub ShowArray(LocArray())
Dim i as integer
Dim msgstring
msgstring = &quot;&quot;
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
2001-05-11 09:23:53 -05:00
Dim MaxIndex as Integer
2001-05-04 09:15:07 -05:00
On Local Error Goto NOPROPERTYSETINFO:
sValues = &quot;&quot;
2001-05-11 09:23:53 -05:00
MaxIndex = Ubound(oLocObject.PropertySetInfo.Properties)
For i = 0 To MaxIndex
2001-05-04 09:15:07 -05:00
Propname = oLocObject.PropertySetInfo.Properties(i).Name
2001-05-11 09:23:53 -05:00
sValues = sValues &amp; PropName &amp; oLocObject.GetPropertyValue(PropName) &amp; chr(13)
2001-05-04 09:15:07 -05:00
Next i
Msgbox(sValues , 64, GetProductName())
Exit Sub
NOPROPERTYSETINFO:
Msgbox(&quot;Sorry, No PropertySetInfo attached to the object&quot;, 16, GetProductName())
Resume LEAVEPROC
LEAVEPROC:
End Sub
Sub ShowNameValuePair(Pair())
Dim i as Integer
Dim ShowString as String
ShowString = &quot;&quot;
On Local Error Resume Next
For i = 0 To Ubound(Pair())
ShowString = ShowString &amp; Pair(i).Name &amp; &quot; = &quot;
ShowString = ShowString &amp; Pair(i).Value &amp; chr(13)
Next i
Msgbox ShowString
End Sub
&apos; Retrieves all the Elements of aSequence of an object, with the
&apos; possibility to define a filter(sfilter &lt;&gt; &quot;&quot;)
Sub ShowElementNames(oLocElements() as Object, Optional sFiltername as String)
Dim i as Integer
Dim NameString as String
NameString = &quot;&quot;
For i = 0 To Ubound(oLocElements())
If Not IsMissIng(sFilterName) Then
If Instr(1, oLocElements(i), sFilterName) Then
NameString = NameString &amp; oLocElements(i) &amp; chr(13)
End If
Else
NameString = NameString &amp; oLocElements(i) &amp; chr(13)
End If
Next i
Msgbox(NameString, 64, GetProductName())
End Sub
&apos; Retrieves all the supported servicenames of an object, with the
&apos; possibility to define a filter(sfilter &lt;&gt; &quot;&quot;)
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(&quot;Sorry, No &apos;SupportedServiceNames&apos; - Property attached to the object&quot;, 16, GetProductName())
Resume LEAVEPROC
LEAVEPROC:
End Sub
&apos; Retrieves all the available Servicenames of an object, with the
&apos; possibility to define a filter(sfilter &lt;&gt; &quot;&quot;)
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(&quot;Sorry, No &apos;AvailableServiceNames&apos; - Property attached to the object&quot;, 16, GetProductName())
Resume LEAVEPROC
LEAVEPROC:
End Sub
Sub ShowCommands(oLocObject as Object)
On Local Error Goto NOCOMMANDS
ShowElementNames(oLocObject.QueryCommands)
Exit Sub
NOCOMMANDS:
Msgbox(&quot;Sorry, No &apos;QueryCommands&apos; - Property attached to the object&quot;, 16, GetProductName())
Resume LEAVEPROC
LEAVEPROC:
End Sub
</script:module>