wizards/source/tools/Debug.xba

   1 <?xml version="1.0" encoding="UTF-8"?>
   2 <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
   3 <script:module xmlns:script="http://openoffice.org/2000/script" script:name="Debug" script:language="StarBasic">REM  *****  BASIC  *****
   4
   5 Sub ActivateReadOnlyFlag()
   6         SetBasicReadOnlyFlag(True)
   7 End Sub
   8
   9
  10 Sub DeactivateReadOnlyFlag()
  11         SetBasicReadOnlyFlag(False)
  12 End Sub
  13
  14
  15 Sub SetBasicReadOnlyFlag(bReadOnly as Boolean)
  16 Dim i as Integer
  17 Dim LibName as String
  18 Dim BasicLibNames() as String
  19         BasicLibNames() = BasicLibraries.ElementNames()
  20         For i = 0 To Ubound(BasicLibNames())
  21                 LibName = BasicLibNames(i)
  22                 If LibName &lt;&gt; &quot;Standard&quot; Then
  23                         BasicLibraries.SetLibraryReadOnly(LibName, bReadOnly)
  24                 End If
  25         Next i
  26 End Sub
  27
  28
  29 Sub WritedbgInfo(LocObject as Object)
  30 Dim locUrl as String
  31 Dim oLocDocument as Object
  32 Dim oLocText as Object
  33 Dim oLocCursor as Object
  34 Dim NoArgs()
  35 Dim sObjectStrings(2) as String
  36 Dim sProperties() as String
  37 Dim n as Integer
  38 Dim m as Integer
  39 Dim MaxIndex as Integer
  40         sObjectStrings(0) = LocObject.dbg_Properties
  41         sObjectStrings(1) = LocObject.dbg_Methods
  42         sObjectStrings(2) = LocObject.dbg_SupportedInterfaces
  43         LocUrl = &quot;private:factory/swriter&quot;
  44         oLocDocument = StarDesktop.LoadComponentFromURL(LocUrl,&quot;_default&quot;,0,NoArgs)
  45         oLocText = oLocDocument.text
  46         oLocCursor = oLocText.createTextCursor()
  47         oLocCursor.gotoStart(False)
  48         If Vartype(LocObject) = 9 then  &apos; an Object Variable
  49                 For n = 0 To 2
  50                         sProperties() = ArrayoutofString(sObjectStrings(n),&quot;;&quot;, MaxIndex)
  51                         For m = 0 To MaxIndex
  52                                 oLocText.insertString(oLocCursor,sProperties(m),False)
  53                                 oLocText.insertControlCharacter(oLocCursor,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False)
  54                         Next m
  55                 Next n
  56         Elseif Vartype(LocObject) = 8 Then      &apos; a String Variable
  57                 oLocText.insertString(oLocCursor,LocObject,False)
  58         ElseIf Vartype(LocObject) = 1 Then
  59                 Msgbox(&quot;Variable is Null!&quot;, 16, GetProductName())
  60         End If
  61 End Sub
  62
  63
  64 Sub WriteDbgString(LocString as string)
  65 Dim oLocDesktop as object
  66 Dim LocUrl as String
  67 Dim oLocDocument as Object
  68 Dim oLocCursor as Object
  69 Dim oLocText as Object
  70
  71         LocUrl = &quot;private:factory/swriter&quot;
  72         oLocDocument = StarDesktop.LoadComponentFromURL(LocUrl,&quot;_default&quot;,0,NoArgs)
  73         oLocText = oLocDocument.text
  74         oLocCursor = oLocText.createTextCursor()
  75         oLocCursor.gotoStart(False)
  76         oLocText.insertString(oLocCursor,LocString,False)
  77 End Sub
  78
  79
  80 Sub printdbgInfo(LocObject)
  81         If Vartype(LocObject) = 9 then
  82                 Msgbox LocObject.dbg_properties
  83                 Msgbox LocObject.dbg_methods
  84                 Msgbox LocObject.dbg_supportedinterfaces
  85         Elseif Vartype(LocObject) = 8 Then      &apos; a String Variable
  86                 Msgbox LocObject
  87         ElseIf Vartype(LocObject) = 0 Then
  88                 Msgbox(&quot;Variable is Null!&quot;, 16, GetProductName())
  89         Else
  90                 Msgbox(&quot;Type of Variable: &quot; &amp; Typename(LocObject), 48, GetProductName())
  91         End If
  92 End Sub
  93
  94
  95 Sub ShowArray(LocArray())
  96 Dim i as integer
  97 Dim msgstring
  98         msgstring = &quot;&quot;
  99         For i = Lbound(LocArray()) to Ubound(LocArray())
 100                 msgstring = msgstring + LocArray(i) + chr(13)
 101         Next
 102         Msgbox msgstring
 103 End Sub
 104
 105
 106 Sub ShowPropertyValues(oLocObject as Object)
 107 Dim PropName as String
 108 Dim sValues as String
 109         On Local Error Goto NOPROPERTYSETINFO:
 110         sValues = &quot;&quot;
 111         For i = 0 To Ubound(oLocObject.PropertySetInfo.Properties)
 112                 Propname = oLocObject.PropertySetInfo.Properties(i).Name
 113                 sValues = sValues &amp; PropName &amp; chr(13) &amp; &quot; = &quot; &amp; oLocObject.GetPropertyValue(PropName) &amp; chr(13)
 114         Next i
 115         Msgbox(sValues , 64, GetProductName())
 116         Exit Sub
 117
 118 NOPROPERTYSETINFO:
 119         Msgbox(&quot;Sorry, No PropertySetInfo attached to the object&quot;, 16, GetProductName())
 120         Resume LEAVEPROC
 121         LEAVEPROC:
 122 End Sub
 123
 124
 125 Sub ShowNameValuePair(Pair())
 126 Dim i as Integer
 127 Dim ShowString as String
 128         ShowString = &quot;&quot;
 129         On Local Error Resume Next
 130         For i = 0 To Ubound(Pair())
 131                 ShowString = ShowString &amp; Pair(i).Name &amp; &quot; = &quot;
 132                 ShowString = ShowString &amp; Pair(i).Value &amp; chr(13)
 133         Next i
 134         Msgbox ShowString
 135 End Sub
 136
 137
 138 &apos; Retrieves all the Elements of aSequence of an object, with the
 139 &apos; possibility to define a filter(sfilter &lt;&gt; &quot;&quot;)
 140 Sub ShowElementNames(oLocElements() as Object, Optional sFiltername as String)
 141 Dim i as Integer
 142 Dim NameString as String
 143         NameString = &quot;&quot;
 144         For i = 0 To Ubound(oLocElements())
 145                 If Not IsMissIng(sFilterName) Then
 146                         If Instr(1, oLocElements(i), sFilterName) Then
 147                                 NameString = NameString &amp; oLocElements(i) &amp; chr(13)
 148                         End If
 149                 Else
 150                         NameString = NameString &amp; oLocElements(i) &amp; chr(13)
 151                 End If
 152         Next i
 153         Msgbox(NameString, 64, GetProductName())
 154 End Sub
 155
 156
 157 &apos; Retrieves all the supported servicenames of an object, with the
 158 &apos; possibility to define a filter(sfilter &lt;&gt; &quot;&quot;)
 159 Sub ShowSupportedServiceNames(oLocObject as Object, Optional sFilterName as String)
 160         On Local Error Goto NOSERVICENAMES
 161         If IsMissing(sFilterName) Then
 162                 ShowElementNames(oLocobject.SupportedServiceNames())
 163         Else
 164                 ShowElementNames(oLocobject.SupportedServiceNames(), sFilterName)
 165         End If
 166         Exit Sub
 167
 168         NOSERVICENAMES:
 169         Msgbox(&quot;Sorry, No &apos;SupportedServiceNames&apos; - Property attached to the object&quot;, 16, GetProductName())
 170         Resume LEAVEPROC
 171         LEAVEPROC:
 172 End Sub
 173
 174
 175 &apos; Retrieves all the available Servicenames of an object, with the
 176 &apos; possibility to define a filter(sfilter &lt;&gt; &quot;&quot;)
 177 Sub ShowAvailableServiceNames(oLocObject as Object, Optional sFilterName as String)
 178         On Local Error Goto NOSERVICENAMES
 179         If IsMissing(sFilterName) Then
 180                 ShowElementNames(oLocobject.AvailableServiceNames)
 181         Else
 182                 ShowElementNames(oLocobject.AvailableServiceNames, sFilterName)
 183         End If
 184         Exit Sub
 185
 186         NOSERVICENAMES:
 187         Msgbox(&quot;Sorry, No &apos;AvailableServiceNames&apos; - Property attached to the object&quot;, 16, GetProductName())
 188         Resume LEAVEPROC
 189         LEAVEPROC:
 190 End Sub
 191
 192
 193 Sub ShowCommands(oLocObject as Object)
 194         On Local Error Goto NOCOMMANDS
 195         ShowElementNames(oLocObject.QueryCommands)
 196         Exit Sub
 197         NOCOMMANDS:
 198         Msgbox(&quot;Sorry, No &apos;QueryCommands&apos; - Property attached to the object&quot;, 16, GetProductName())
 199         Resume LEAVEPROC
 200         LEAVEPROC:
 201 End Sub
 202
 203
 204 Sub ProtectCurrentSheets()
 205 Dim oDocument as Object
 206 Dim sDocType as String
 207 Dim iResult as Integer
 208 Dim oSheets as Object
 209 Dim i as Integer
 210 Dim bDoProtect as Boolean
 211         oDocument = StarDesktop.ActiveFrame.Controller.Model
 212         sDocType = GetDocumentType(oDocument)
 213         If sDocType = &quot;scalc&quot; Then
 214                 oSheets = oDocument.Sheets
 215                 bDoProtect = False
 216                 For i = 0 To oSheets.Count-1
 217                         If Not oSheets(i).IsProtected Then
 218                                 bDoProtect = True
 219                         End If
 220                 Next i
 221                 If bDoProtect Then
 222                         iResult = Msgbox( &quot;Do you want to protect all sheets of this document?&quot;,35, GetProductName())
 223                         If iResult = 6 Then
 224                                 ProtectSheets(oDocument.Sheets)
 225                         End If
 226                 End If
 227         End If
 228 End Sub
 229
 230
 231 Sub FillDocument()
 232         oMyReport = createUNOService(&quot;com.sun.star.wizards.report.CallReportWizard&quot;)
 233         oMyReport.trigger(&quot;fill&quot;)
 234 End Sub
 235
 236 </script:module>