290 lines
No EOL
9.9 KiB
XML
290 lines
No EOL
9.9 KiB
XML
<?xml version="1.0" encoding="UTF-8"?>
|
|
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
|
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="ModuleControls" script:language="StarBasic">Option Explicit
|
|
'bla
|
|
|
|
' Accepts the name of a control and returns the respective control model as object
|
|
' The Container can either be a whole document or a specific sheet of a Calc-Document
|
|
' 'CName' is the name of the Control
|
|
Function getControlModel(oContainer as Object, CName as String)
|
|
Dim aForm, oForms as Object
|
|
Dim i as Integer
|
|
oForms = oContainer.Drawpage.GetForms
|
|
For i = 0 To oForms.Count-1
|
|
aForm = oForms.GetbyIndex(i)
|
|
If aForm.HasByName(CName) Then
|
|
GetControlModel = aForm.GetbyName(CName)
|
|
Exit Function
|
|
End If
|
|
Next i
|
|
Msgbox("No Control with the name '" & CName & "' found" , 16, GetProductName())
|
|
End Function
|
|
|
|
|
|
|
|
' Gets the Shape of a Control( e. g. to reset the size or Position of the control
|
|
' Parameters:
|
|
' The 'oContainer' is the Document or a specific sheet of a Calc - Document
|
|
' 'CName' is the Name of the Control
|
|
Function GetControlShape(oContainer as Object,CName as String)
|
|
Dim i as integer
|
|
Dim aShape as Object
|
|
For i = 0 to oContainer.DrawPage.Count-1
|
|
aShape = oContainer.DrawPage(i)
|
|
If HasUnoInterfaces(aShape, "com.sun.star.drawing.XControlShape") then
|
|
If ashape.Control.Name = CName then
|
|
GetControlShape = aShape
|
|
exit Function
|
|
End If
|
|
End If
|
|
Next
|
|
End Function
|
|
|
|
|
|
' Returns the View of a Control
|
|
' Parameters:
|
|
' The 'oContainer' is the Document or a specific sheet of a Calc - Document
|
|
' The 'oController' is always directly attached to the Document
|
|
' 'CName' is the Name of the Control
|
|
Function getControlView(oContainer , oController as Object, CName as String) as Object
|
|
Dim aForm, oForms, oControlModel as Object
|
|
Dim i as Integer
|
|
oForms = oContainer.DrawPage.Forms
|
|
For i = 0 To oForms.Count-1
|
|
aForm = oforms.GetbyIndex(i)
|
|
If aForm.HasByName(CName) Then
|
|
oControlModel = aForm.GetbyName(CName)
|
|
GetControlView = oController.GetControl(oControlModel)
|
|
Exit Function
|
|
End If
|
|
Next i
|
|
Msgbox("No Control with the name '" & CName & "' found" , 16, GetProductName())
|
|
End Function
|
|
|
|
|
|
|
|
' Parameters:
|
|
' The 'oContainer' is the Document or a specific sheet of a Calc - Document
|
|
' 'CName' is the Name of the Control
|
|
Function DisposeControl(oContainer as Object, CName as String) as Boolean
|
|
Dim aControl as Object
|
|
|
|
aControl = GetControlModel(oContainer,CName)
|
|
If not IsNull(aControl) Then
|
|
aControl.Dispose()
|
|
DisposeControl = True
|
|
Else
|
|
DisposeControl = False
|
|
End If
|
|
End Function
|
|
|
|
|
|
' Returns a sequence of a group of controls like option buttons or checkboxes
|
|
' The 'oContainer' is the Document or a specific sheet of a Calc - Document
|
|
' 'sGroupName' is the Name of the Controlgroup
|
|
Function GetControlGroupModel(oContainer as Object, sGroupName as String )
|
|
Dim aForm, oForms As Object
|
|
Dim aControlModel() As Object
|
|
Dim i as integer
|
|
|
|
oForms = oContainer.DrawPage.Forms
|
|
For i = 0 To oForms.Count-1
|
|
aForm = oForms(i)
|
|
If aForm.HasbyName(sGroupName) Then
|
|
aForm.GetGroupbyName(sGroupName,aControlModel)
|
|
GetControlGroupModel = aControlModel
|
|
Exit Function
|
|
End If
|
|
Next i
|
|
Msgbox("No Controlgroup with the name '" & sGroupName & "' found" , 16, GetProductName())
|
|
End Function
|
|
|
|
|
|
' Returns the Referencevalue of a group of e.g. option buttons or check boxes
|
|
' 'oControlGroup' is a sequence of the Control objects
|
|
Function GetRefValue(oControlGroup() as Object)
|
|
Dim i as Integer
|
|
For i = 0 To Ubound(oControlGroup())
|
|
' oControlGroup(i).DefaultState = oControlGroup(i).State
|
|
If oControlGroup(i).State Then
|
|
GetRefValue = oControlGroup(i).RefValue
|
|
exit Function
|
|
End If
|
|
Next
|
|
Msgbox("No Control selected!",16, GetProductName())
|
|
End Function
|
|
|
|
|
|
Function GetRefValueOfControlGroup(oContainer as Object, GroupName as String)
|
|
Dim oOptGroup() as Object
|
|
Dim iRef as Integer
|
|
oOptGroup() = GetControlGroupModel(oContainer, GroupName)
|
|
iRef = GetRefValue(oOptGroup())
|
|
GetRefValueofControlGroup = iRef
|
|
End Function
|
|
|
|
|
|
Function GetOptionGroupValue(oContainer as Object, OptGroupName as String) as Boolean
|
|
Dim oRulesOptions() as Object
|
|
oRulesOptions() = GetControlGroupModel(oContainer, OptGroupName)
|
|
GetOptionGroupValue = oRulesOptions(0).State
|
|
End Function
|
|
|
|
|
|
|
|
Function WriteOptValueToCell(oSheet as Object, OptGroupName as String, iCol as Integer, iRow as Integer) as Boolean
|
|
Dim bOptValue as Boolean
|
|
Dim oCell as Object
|
|
bOptValue = GetOptionGroupValue(oSheet, OptGroupName)
|
|
oCell = oSheet.GetCellByPosition(iCol, iRow)
|
|
oCell.SetValue(ABS(CInt(bOptValue)))
|
|
WriteOptValueToCell() = bOptValue
|
|
End Function
|
|
|
|
|
|
Function LoadDialog(Libname as String, DialogName as String, Optional oLibContainer)
|
|
Dim oLib as Object
|
|
Dim oLibDialog as Object
|
|
Dim oRuntimeDialog as Object
|
|
If IsMissing(oLibContainer ) then
|
|
oLibContainer = DialogLibraries
|
|
End If
|
|
oLibContainer.LoadLibrary(LibName)
|
|
oLib = oLibContainer.GetByName(Libname)
|
|
oLibDialog = oLib.GetByName(DialogName)
|
|
oRuntimeDialog = CreateUnoDialog(oLibDialog)
|
|
LoadDialog() = oRuntimeDialog
|
|
End Function
|
|
|
|
|
|
Sub GetFolderName(oRefModel as Object)
|
|
Dim oFolderDialog as Object
|
|
Dim iAccept as Integer
|
|
Dim sPath as String
|
|
Dim InitPath as String
|
|
Dim RefControlName as String
|
|
Dim oUcb as object
|
|
'Note: The following services have to be called in the following order
|
|
' because otherwise Basic does not remove the FileDialog Service
|
|
oFolderDialog = CreateUnoService("com.sun.star.ui.dialogs.FolderPicker")
|
|
oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess")
|
|
InitPath = ConvertToUrl(oRefModel.Text)
|
|
If InitPath = "" Then
|
|
InitPath = GetPathSettings("Work")
|
|
End If
|
|
If oUcb.Exists(InitPath) Then
|
|
oFolderDialog.SetDisplayDirectory(InitPath)
|
|
End If
|
|
iAccept = oFolderDialog.Execute()
|
|
If iAccept = 1 Then
|
|
sPath = oFolderDialog.GetDirectory()
|
|
If oUcb.Exists(sPath) Then
|
|
oRefModel.Text = ConvertFromUrl(sPath)
|
|
End If
|
|
End If
|
|
End Sub
|
|
|
|
|
|
Sub GetFileName(oRefModel as Object, Filternames())
|
|
Dim oFileDialog as Object
|
|
Dim iAccept as Integer
|
|
Dim sPath as String
|
|
Dim InitPath as String
|
|
Dim RefControlName as String
|
|
Dim oUcb as object
|
|
'Dim ListAny(0)
|
|
'Note: The following services have to be called in the following order
|
|
' because otherwise Basic does not remove the FileDialog Service
|
|
oFileDialog = CreateUnoService("com.sun.star.ui.dialogs.FilePicker")
|
|
oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess")
|
|
'ListAny(0) = com.sun.star.ui.dialogs.TemplateDescription.FILEOPEN_SIMPLE
|
|
'oFileDialog.initialize(ListAny())
|
|
AddFiltersToDialog(FilterNames(), oFileDialog)
|
|
InitPath = ConvertToUrl(oRefModel.Text)
|
|
If InitPath = "" Then
|
|
InitPath = GetPathSettings("Work")
|
|
End If
|
|
If oUcb.Exists(InitPath) Then
|
|
oFileDialog.SetDisplayDirectory(InitPath)
|
|
End If
|
|
iAccept = oFileDialog.Execute()
|
|
If iAccept = 1 Then
|
|
sPath = oFileDialog.Files(0)
|
|
If oUcb.Exists(sPath) Then
|
|
oRefModel.Text = ConvertFromUrl(sPath)
|
|
End If
|
|
End If
|
|
End Sub
|
|
|
|
|
|
Function StoreDocument(oDocument as Object, FilterNames() as String, DefaultName as String, DisplayDirectory as String) as String
|
|
Dim NoArgs() as New com.sun.star.beans.PropertyValue
|
|
Dim oStoreProperties(0) as New com.sun.star.beans.PropertyValue
|
|
Dim oStoreDialog as Object
|
|
Dim iAccept as Integer
|
|
Dim sPath as String
|
|
Dim ListAny(0) as Long
|
|
Dim UIFilterName as String
|
|
Dim FilterName as String
|
|
Dim FilterIndex as Integer
|
|
ListAny(0) = com.sun.star.ui.dialogs.TemplateDescription.FILESAVE_AUTOEXTENSION_PASSWORD_FILTEROPTIONS
|
|
oStoreDialog = CreateUnoService("com.sun.star.ui.dialogs.FilePicker")
|
|
oStoreDialog.Initialize(ListAny())
|
|
AddFiltersToDialog(FilterNames(), oStoreDialog)
|
|
oStoreDialog.SetDisplayDirectory(DisplayDirectory)
|
|
oStoreDialog.SetDefaultName(DefaultName)
|
|
iAccept = oStoreDialog.Execute()
|
|
If iAccept = 1 Then
|
|
sPath = oStoreDialog.Files(0)
|
|
UIFilterName = oStoreDialog.GetCurrentFilter()
|
|
FilterIndex = IndexInArray(UIFilterName, FilterNames())
|
|
FilterName = FilterNames(FilterIndex,2)
|
|
On Local Error Goto NOSAVING
|
|
If FilterName = "" Then
|
|
' Todo: Den Fall abfangen, wenn ein zu überschreibendes Dokument schreibgeschützt ist (weil es z.B. gerade geöffnet ist)
|
|
oDocument.StoreAsUrl(sPath, NoArgs())
|
|
Else
|
|
oStoreProperties(0).Name = "FilterName"
|
|
oStoreProperties(0).Value = FilterName
|
|
oDocument.StoreAsUrl(sPath, oStoreProperties())
|
|
End If
|
|
End If
|
|
StoreDocument() = sPath
|
|
Exit Function
|
|
NOSAVING:
|
|
If Err <> 0 Then
|
|
' Msgbox("Document cannot be saved under '" & ConvertFromUrl(sPath) & "'", 48, GetProductName())
|
|
sPath = ""
|
|
Resume NOERROR
|
|
NOERROR:
|
|
End If
|
|
End Function
|
|
|
|
|
|
Sub AddFiltersToDialog(FilterNames() as String, oDialog as Object)
|
|
Dim i as Integer
|
|
Dim MaxIndex as Integer
|
|
Dim ViewFiltername as String
|
|
Dim oProdNameAccess as Object
|
|
Dim sProdName as String
|
|
oProdNameAccess = GetRegistryKeyContent("org.openoffice.Setup/Product")
|
|
sProdName = oProdNameAccess.getByName("ooName")
|
|
MaxIndex = Ubound(FilterNames(), 1)
|
|
For i = 0 To MaxIndex
|
|
Filternames(i,0) = ReplaceString(Filternames(i,0), sProdName,"%productname%")
|
|
oDialog.AppendFilter(FilterNames(i,0), FilterNames(i,1))
|
|
Next i
|
|
oDialog.SetCurrentFilter(FilterNames(0,0)
|
|
End Sub
|
|
|
|
|
|
Sub SwitchMousePointer(oWindowPeer as Object, bDoEnable as Boolean)
|
|
Dim oWindowPointer as Object
|
|
oWindowPointer = CreateUnoService("com.sun.star.awt.Pointer")
|
|
If bDoEnable Then
|
|
oWindowPointer.SetType(com.sun.star.awt.SystemPointer.ARROW)
|
|
Else
|
|
oWindowPointer.SetType(com.sun.star.awt.SystemPointer.WAIT)
|
|
End If
|
|
oWindowPeer.SetPointer(oWindowPointer)
|
|
End Sub</script:module> |