home *** CD-ROM | disk | FTP | other *** search
/ PC World 2003 March / PCWorld_2003-03_cd.bin / Software / Vyzkuste / openoffice / f_0078 / Debug.xba next >
Extensible Markup Language  |  2001-12-18  |  7KB  |  229 lines

  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 <> "Standard" 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 = "private:factory/swriter"
  44.     oLocDocument = StarDesktop.LoadComponentFromURL(LocUrl,"_blank",0,NoArgs)
  45.     oLocText = oLocDocument.text
  46.     oLocCursor = oLocText.createTextCursor()
  47.     oLocCursor.gotoStart(False)
  48.     If Vartype(LocObject) = 9 then    ' an Object Variable
  49.         For n = 0 To 2
  50.             sProperties() = ArrayoutofString(sObjectStrings(n),";", 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    ' a String Variable
  57.         oLocText.insertString(oLocCursor,LocObject,False)
  58.     ElseIf Vartype(LocObject) = 1 Then
  59.         Msgbox("Variable is Null!", 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 = "private:factory/swriter"
  72.     oLocDocument = StarDesktop.LoadComponentFromURL(LocUrl,"_blank",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    ' a String Variable
  86.         Msgbox LocObject
  87.     ElseIf Vartype(LocObject) = 0 Then
  88.         Msgbox("Variable is Null!", 16, GetProductName())
  89.     Else
  90.         Msgbox("Type of Variable: " & 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 = ""
  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 = ""
  111.     For i = 0 To Ubound(oLocObject.PropertySetInfo.Properties)
  112.         Propname = oLocObject.PropertySetInfo.Properties(i).Name
  113.         sValues = sValues & PropName & chr(13) & " = " & oLocObject.GetPropertyValue(PropName) & chr(13)
  114.     Next i
  115.     Msgbox(sValues , 64, GetProductName())
  116.     Exit Sub
  117.  
  118. NOPROPERTYSETINFO:
  119.     Msgbox("Sorry, No PropertySetInfo attached to the object", 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 = ""
  129.     On Local Error Resume Next
  130.     For i = 0 To Ubound(Pair())
  131.         ShowString = ShowString & Pair(i).Name & " = "
  132.         ShowString = ShowString & Pair(i).Value & chr(13)
  133.     Next i
  134.     Msgbox ShowString
  135. End Sub
  136.  
  137.  
  138. ' Retrieves all the Elements of aSequence of an object, with the
  139. ' possibility to define a filter(sfilter <> "")
  140. Sub ShowElementNames(oLocElements() as Object, Optional sFiltername as String)
  141. Dim i as Integer
  142. Dim NameString as String
  143.     NameString = ""
  144.     For i = 0 To Ubound(oLocElements())
  145.         If Not IsMissIng(sFilterName) Then
  146.             If Instr(1, oLocElements(i), sFilterName) Then
  147.                 NameString = NameString & oLocElements(i) & chr(13)
  148.             End If
  149.         Else
  150.             NameString = NameString & oLocElements(i) & chr(13)
  151.         End If
  152.     Next i
  153.     Msgbox(NameString, 64, GetProductName())
  154. End Sub
  155.  
  156.  
  157. ' Retrieves all the supported servicenames of an object, with the
  158. ' possibility to define a filter(sfilter <> "")
  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("Sorry, No 'SupportedServiceNames' - Property attached to the object", 16, GetProductName())
  170.     Resume LEAVEPROC
  171.     LEAVEPROC:
  172. End Sub
  173.  
  174.  
  175. ' Retrieves all the available Servicenames of an object, with the
  176. ' possibility to define a filter(sfilter <> "")
  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("Sorry, No 'AvailableServiceNames' - Property attached to the object", 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("Sorry, No 'QueryCommands' - Property attached to the object", 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 = "scalc" 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( "Do you want to protect all sheets of this document?",35, GetProductName())
  223.             If iResult = 6 Then
  224.                 ProtectSheets(oDocument.Sheets)
  225.             End If
  226.         End If
  227.     End If
  228. End Sub
  229. </script:module>