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