home *** CD-ROM | disk | FTP | other *** search
/ PC World 2003 March / PCWorld_2003-03_cd.bin / Software / Vyzkuste / openoffice / f_0078 / ModuleControls.xba < prev    next >
Extensible Markup Language  |  2001-12-18  |  10KB  |  296 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="ModuleControls" script:language="StarBasic">Option Explicit
  4. 'bla
  5.  
  6. ' Accepts the name of a control and returns the respective control model as object
  7. ' The Container can either be a whole document or a specific sheet of a Calc-Document
  8. ' 'CName' is the name of the Control
  9. Function getControlModel(oContainer as Object, CName as String)
  10. Dim aForm, oForms as Object
  11. Dim i as Integer
  12.     oForms = oContainer.Drawpage.GetForms
  13.     For i = 0 To oForms.Count-1
  14.         aForm = oForms.GetbyIndex(i)
  15.         If aForm.HasByName(CName) Then
  16.             GetControlModel = aForm.GetbyName(CName)
  17.             Exit Function
  18.         End If
  19.     Next i
  20.     Msgbox("No Control with the name '" & CName & "' found" , 16, GetProductName())
  21. End Function
  22.  
  23.  
  24.  
  25. ' Gets the Shape of a Control( e. g. to reset the size or Position of the control
  26. ' Parameters:
  27. ' The 'oContainer' is the Document or a specific sheet of a Calc - Document
  28. ' 'CName' is the Name of the Control
  29. Function GetControlShape(oContainer as Object,CName as String)
  30. Dim i as integer
  31. Dim aShape as Object
  32.     For i = 0 to oContainer.DrawPage.Count-1
  33.         aShape = oContainer.DrawPage(i)
  34.         If HasUnoInterfaces(aShape, "com.sun.star.drawing.XControlShape") then
  35.             If ashape.Control.Name = CName then
  36.                 GetControlShape = aShape
  37.                 exit Function
  38.             End If
  39.         End If
  40.     Next
  41. End Function
  42.  
  43.  
  44. ' Returns the View of a Control
  45. ' Parameters:
  46. ' The 'oContainer' is the Document or a specific sheet of a Calc - Document
  47. ' The 'oController' is always directly attached to the Document
  48. ' 'CName' is the Name of the Control
  49. Function getControlView(oContainer , oController as Object, CName as String) as Object
  50. Dim aForm, oForms, oControlModel as Object
  51. Dim i as Integer
  52.     oForms = oContainer.DrawPage.Forms
  53.     For i = 0 To oForms.Count-1
  54.         aForm = oforms.GetbyIndex(i)
  55.         If aForm.HasByName(CName) Then
  56.             oControlModel = aForm.GetbyName(CName)
  57.             GetControlView = oController.GetControl(oControlModel)
  58.             Exit Function
  59.         End If
  60.     Next i
  61.     Msgbox("No Control with the name '" & CName & "' found" , 16, GetProductName())
  62. End Function
  63.  
  64.  
  65.  
  66. ' Parameters:
  67. ' The 'oContainer' is the Document or a specific sheet of a Calc - Document
  68. ' 'CName' is the Name of the Control
  69. Function DisposeControl(oContainer as Object, CName as String) as Boolean
  70. Dim aControl as Object
  71.  
  72.     aControl = GetControlModel(oContainer,CName)
  73.     If not IsNull(aControl) Then
  74.         aControl.Dispose()
  75.         DisposeControl = True
  76.     Else
  77.         DisposeControl = False
  78.     End If
  79. End Function
  80.  
  81.  
  82. ' Returns a sequence of a group of controls like option buttons or checkboxes
  83. ' The 'oContainer' is the Document or a specific sheet of a Calc - Document
  84. ' 'sGroupName' is the Name of the Controlgroup
  85. Function GetControlGroupModel(oContainer as Object, sGroupName as String )
  86. Dim aForm, oForms As Object
  87. Dim aControlModel() As Object
  88. Dim i as integer
  89.  
  90.     oForms = oContainer.DrawPage.Forms
  91.     For i = 0 To oForms.Count-1
  92.         aForm = oForms(i)
  93.         If aForm.HasbyName(sGroupName) Then
  94.             aForm.GetGroupbyName(sGroupName,aControlModel)
  95.             GetControlGroupModel = aControlModel
  96.             Exit Function
  97.         End If
  98.     Next i
  99.     Msgbox("No Controlgroup with the name '" & sGroupName & "' found" , 16, GetProductName())
  100. End Function
  101.  
  102.  
  103. ' Returns the Referencevalue of a group of e.g. option buttons or check boxes
  104. ' 'oControlGroup' is a sequence of the Control objects
  105. Function GetRefValue(oControlGroup() as Object)
  106. Dim i as Integer
  107.     For i = 0 To Ubound(oControlGroup())
  108. '        oControlGroup(i).DefaultState = oControlGroup(i).State
  109.         If oControlGroup(i).State Then
  110.             GetRefValue = oControlGroup(i).RefValue
  111.             exit Function
  112.         End If
  113.     Next
  114.     Msgbox("No Control selected!",16, GetProductName())
  115. End Function
  116.  
  117.  
  118. Function GetRefValueOfControlGroup(oContainer as Object, GroupName as String)
  119. Dim oOptGroup() as Object
  120. Dim iRef as Integer
  121.     oOptGroup() = GetControlGroupModel(oContainer, GroupName)
  122.     iRef = GetRefValue(oOptGroup())
  123.     GetRefValueofControlGroup = iRef
  124. End Function
  125.  
  126.  
  127. Function GetOptionGroupValue(oContainer as Object, OptGroupName as String) as Boolean
  128. Dim oRulesOptions() as Object
  129.     oRulesOptions() = GetControlGroupModel(oContainer, OptGroupName)
  130.     GetOptionGroupValue = oRulesOptions(0).State
  131. End Function
  132.  
  133.  
  134.  
  135. Function WriteOptValueToCell(oSheet as Object, OptGroupName as String, iCol as Integer, iRow as Integer) as Boolean
  136. Dim bOptValue as Boolean
  137. Dim oCell as Object
  138.     bOptValue = GetOptionGroupValue(oSheet, OptGroupName)
  139.     oCell = oSheet.GetCellByPosition(iCol, iRow)
  140.     oCell.SetValue(ABS(CInt(bOptValue)))
  141.     WriteOptValueToCell() = bOptValue
  142. End Function
  143.  
  144.  
  145. Function LoadDialog(Libname as String, DialogName as String, Optional oLibContainer)
  146. Dim oLib as Object
  147. Dim oLibDialog as Object
  148. Dim oRuntimeDialog as Object
  149.     If IsMissing(oLibContainer ) then
  150.         oLibContainer = DialogLibraries
  151.     End If
  152.     oLibContainer.LoadLibrary(LibName)
  153.     oLib = oLibContainer.GetByName(Libname)
  154.     oLibDialog = oLib.GetByName(DialogName)
  155.     oRuntimeDialog = CreateUnoDialog(oLibDialog)
  156.     LoadDialog() = oRuntimeDialog
  157. End Function
  158.  
  159.  
  160. Sub GetFolderName(oRefModel as Object)
  161. Dim oFolderDialog as Object
  162. Dim iAccept as Integer
  163. Dim sPath as String
  164. Dim InitPath as String
  165. Dim RefControlName as String
  166. Dim oUcb as object
  167.     'Note: The following services have to be called in the following order
  168.     ' because otherwise Basic does not remove the FileDialog Service
  169.     oFolderDialog = CreateUnoService("com.sun.star.ui.dialogs.FolderPicker")
  170.     oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess")
  171.     InitPath = ConvertToUrl(oRefModel.Text)
  172.     If InitPath = "" Then
  173.         InitPath = GetPathSettings("Work")
  174.     End If
  175.     If oUcb.Exists(InitPath) Then
  176.         oFolderDialog.SetDisplayDirectory(InitPath)
  177.     End If
  178.     iAccept = oFolderDialog.Execute()
  179.     If iAccept = 1 Then
  180.         sPath = oFolderDialog.GetDirectory()
  181.         If oUcb.Exists(sPath) Then
  182.             oRefModel.Text = ConvertFromUrl(sPath)
  183.         End If
  184.     End If
  185. End Sub
  186.  
  187.  
  188. Sub GetFileName(oRefModel as Object, Filternames())
  189. Dim oFileDialog as Object
  190. Dim iAccept as Integer
  191. Dim sPath as String
  192. Dim InitPath as String
  193. Dim RefControlName as String
  194. Dim oUcb as object
  195. 'Dim ListAny(0)
  196.     'Note: The following services have to be called in the following order
  197.     ' because otherwise Basic does not remove the FileDialog Service
  198.     oFileDialog = CreateUnoService("com.sun.star.ui.dialogs.FilePicker")
  199.     oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess")
  200.     'ListAny(0) = com.sun.star.ui.dialogs.TemplateDescription.FILEOPEN_SIMPLE
  201.     'oFileDialog.initialize(ListAny())
  202.     AddFiltersToDialog(FilterNames(), oFileDialog)
  203.     InitPath = ConvertToUrl(oRefModel.Text)
  204.     If InitPath = "" Then
  205.         InitPath = GetPathSettings("Work")
  206.     End If
  207.     If oUcb.Exists(InitPath) Then
  208.         oFileDialog.SetDisplayDirectory(InitPath)
  209.     End If
  210.     iAccept = oFileDialog.Execute()
  211.     If iAccept = 1 Then
  212.         sPath = oFileDialog.Files(0)
  213.         If oUcb.Exists(sPath) Then
  214.             oRefModel.Text = ConvertFromUrl(sPath)
  215.         End If
  216.     End If
  217. End Sub
  218.  
  219.  
  220. Function StoreDocument(oDocument as Object, FilterNames() as String, DefaultName as String, DisplayDirectory as String, Optional iAddProcedure as Integer) as String
  221. Dim NoArgs() as New com.sun.star.beans.PropertyValue
  222. Dim oStoreProperties(0) as New com.sun.star.beans.PropertyValue
  223. Dim oStoreDialog as Object
  224. Dim iAccept as Integer
  225. Dim sPath as String
  226. Dim ListAny(0) as Long
  227. Dim UIFilterName as String
  228. Dim FilterName as String
  229. Dim FilterIndex as Integer
  230.     ListAny(0) = com.sun.star.ui.dialogs.TemplateDescription.FILESAVE_AUTOEXTENSION_PASSWORD_FILTEROPTIONS
  231.     oStoreDialog = CreateUnoService("com.sun.star.ui.dialogs.FilePicker")
  232.     oStoreDialog.Initialize(ListAny())
  233.     AddFiltersToDialog(FilterNames(), oStoreDialog)
  234.     oStoreDialog.SetDisplayDirectory(DisplayDirectory)
  235.     oStoreDialog.SetDefaultName(DefaultName)
  236.     iAccept = oStoreDialog.Execute()
  237.     If iAccept = 1 Then
  238.         sPath = oStoreDialog.Files(0)
  239.         UIFilterName = oStoreDialog.GetCurrentFilter()
  240.         FilterIndex = IndexInArray(UIFilterName, FilterNames())
  241.         FilterName = FilterNames(FilterIndex,2)
  242.         If Not IsMissing(iAddProcedure) Then
  243.             Select Case iAddProcedure
  244.                 Case 1
  245.                     CommitLastDocumentChanges(sPath)
  246.             End Select
  247.         End If
  248.         On Local Error Goto NOSAVING
  249.         If FilterName = ""  Then
  250.             ' Todo: Den Fall abfangen, wenn ein zu ├╝berschreibendes Dokument schreibgesch├╝tzt ist (weil es z.B. gerade ge├╢ffnet ist)
  251.             oDocument.StoreAsUrl(sPath, NoArgs())
  252.         Else
  253.             oStoreProperties(0).Name = "FilterName"
  254.             oStoreProperties(0).Value = FilterName
  255.             oDocument.StoreAsUrl(sPath, oStoreProperties())
  256.         End If
  257.     End If
  258.     StoreDocument() = sPath
  259.     Exit Function
  260. NOSAVING:
  261.     If Err <> 0 Then
  262. '        Msgbox("Document cannot be saved under '" & ConvertFromUrl(sPath) & "'", 48, GetProductName())
  263.         sPath = ""
  264.         Resume NOERROR
  265.         NOERROR:
  266.     End If    
  267. End Function
  268.  
  269.  
  270. Sub AddFiltersToDialog(FilterNames() as String, oDialog as Object)    
  271. Dim i as Integer
  272. Dim MaxIndex as Integer
  273. Dim ViewFiltername as String
  274. Dim oProdNameAccess as Object
  275. Dim sProdName as String
  276.     oProdNameAccess = GetRegistryKeyContent("org.openoffice.Setup/Product")
  277.     sProdName = oProdNameAccess.getByName("ooName")
  278.     MaxIndex = Ubound(FilterNames(), 1)
  279.     For i = 0 To MaxIndex
  280.         Filternames(i,0) = ReplaceString(Filternames(i,0), sProdName,"%productname%")        
  281.         oDialog.AppendFilter(FilterNames(i,0), FilterNames(i,1))
  282.     Next i
  283.     oDialog.SetCurrentFilter(FilterNames(0,0)
  284. End Sub
  285.  
  286.  
  287. Sub SwitchMousePointer(oWindowPeer as Object, bDoEnable as Boolean)
  288. Dim oWindowPointer as Object
  289.     oWindowPointer = CreateUnoService("com.sun.star.awt.Pointer")
  290.     If bDoEnable Then
  291.         oWindowPointer.SetType(com.sun.star.awt.SystemPointer.ARROW)
  292.     Else
  293.         oWindowPointer.SetType(com.sun.star.awt.SystemPointer.WAIT)
  294.     End If
  295.     oWindowPeer.SetPointer(oWindowPointer)
  296. End Sub</script:module>