update
This commit is contained in:
Jane
@@ -0,0 +1,387 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="ModuleControls" script:language="StarBasic">Option Explicit
|
||||
|
||||
Public DlgOverwrite as Object
|
||||
Public Const SBOVERWRITEUNDEFINED as Integer = 0
|
||||
Public Const SBOVERWRITECANCEL as Integer = 2
|
||||
Public Const SBOVERWRITEQUERY as Integer = 7
|
||||
Public Const SBOVERWRITEALWAYS as Integer = 6
|
||||
Public Const SBOVERWRITENEVER as Integer = 8
|
||||
Public iGeneralOverwrite as Integer
|
||||
|
||||
|
||||
|
||||
' 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
|
||||
GetRefValue() = -1
|
||||
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
|
||||
oFileDialog.Dispose()
|
||||
End Sub
|
||||
|
||||
|
||||
Function StoreDocument(oDocument as Object, FilterNames() as String, DefaultName as String, DisplayDirectory as String, Optional iAddProcedure as Integer) 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
|
||||
oStoreDialog = CreateUnoService("com.sun.star.ui.dialogs.FilePicker")
|
||||
oStoreDialog.Initialize(ListAny())
|
||||
AddFiltersToDialog(FilterNames(), oStoreDialog)
|
||||
oStoreDialog.SetDisplayDirectory(DisplayDirectory)
|
||||
oStoreDialog.SetDefaultName(DefaultName)
|
||||
oStoreDialog.setValue(com.sun.star.ui.dialogs.ExtendedFilePickerElementIds.CHECKBOX_AUTOEXTENSION,0, true)
|
||||
|
||||
iAccept = oStoreDialog.Execute()
|
||||
If iAccept = 1 Then
|
||||
sPath = oStoreDialog.Files(0)
|
||||
UIFilterName = oStoreDialog.GetCurrentFilter()
|
||||
FilterIndex = IndexInArray(UIFilterName, FilterNames())
|
||||
FilterName = FilterNames(FilterIndex,2)
|
||||
If Not IsMissing(iAddProcedure) Then
|
||||
Select Case iAddProcedure
|
||||
Case 1
|
||||
CommitLastDocumentChanges(sPath)
|
||||
End Select
|
||||
End If
|
||||
On Local Error Goto NOSAVING
|
||||
If FilterName = "" Then
|
||||
' Todo: Catch the case that a document that has to be overwritten is writeprotected (e.g. it is open)
|
||||
oDocument.StoreAsUrl(sPath, NoArgs())
|
||||
Else
|
||||
oStoreProperties(0).Name = "FilterName"
|
||||
oStoreProperties(0).Value = FilterName
|
||||
oDocument.StoreAsUrl(sPath, oStoreProperties())
|
||||
End If
|
||||
End If
|
||||
oStoreDialog.dispose()
|
||||
StoreDocument() = sPath
|
||||
Exit Function
|
||||
NOSAVING:
|
||||
If Err <> 0 Then
|
||||
' Msgbox("Document cannot be saved under '" & ConvertFromUrl(sPath) & "'", 48, GetProductName())
|
||||
sPath = ""
|
||||
oStoreDialog.dispose()
|
||||
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
|
||||
|
||||
|
||||
Sub ShowOverwriteAllDialog(FilePath as String, sTitle as String)
|
||||
Dim QueryString as String
|
||||
Dim LocRetValue as Integer
|
||||
Dim lblYes as String
|
||||
Dim lblNo as String
|
||||
Dim lblYesToAll as String
|
||||
Dim lblCancel as String
|
||||
Dim OverwriteModel as Object
|
||||
If InitResources(GetProductName()) Then
|
||||
QueryString = GetResText("RID_COMMON_7")
|
||||
QueryString = ReplaceString(QueryString, ConvertFromUrl(FilePath), "<PATH>")
|
||||
If Len(QueryString) > 190 Then
|
||||
QueryString = DeleteStr(QueryString, ".<BR>")
|
||||
End If
|
||||
QueryString = ReplaceString(QueryString, chr(13), "<BR>")
|
||||
lblYes = GetResText("RID_COMMON_8")
|
||||
lblYesToAll = GetResText("RID_COMMON_9")
|
||||
lblNo = GetResText("RID_COMMON_10")
|
||||
lblCancel = GetResText("RID_COMMON_11")
|
||||
DlgOverwrite = LoadDialog("Tools", "DlgOverwriteAll")
|
||||
DlgOverwrite.Title = sTitle
|
||||
OverwriteModel = DlgOverwrite.Model
|
||||
OverwriteModel.cmdYes.Label = lblYes
|
||||
OverwriteModel.cmdYesToAll.Label = lblYesToAll
|
||||
OverwriteModel.cmdNo.Label = lblNo
|
||||
OverwriteModel.cmdCancel.Label = lblCancel
|
||||
OverwriteModel.lblQueryforSave.Label = QueryString
|
||||
OverwriteModel.cmdNo.DefaultButton = True
|
||||
DlgOverwrite.GetControl("cmdNo").SetFocus()
|
||||
iGeneralOverwrite = 999
|
||||
LocRetValue = DlgOverwrite.execute()
|
||||
If iGeneralOverwrite = 999 Then
|
||||
iGeneralOverwrite = SBOVERWRITECANCEL
|
||||
End If
|
||||
DlgOverwrite.dispose()
|
||||
Else
|
||||
iGeneralOverwrite = SBOVERWRITECANCEL
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub SetOVERWRITEToQuery()
|
||||
iGeneralOverwrite = SBOVERWRITEQUERY
|
||||
DlgOverwrite.EndExecute()
|
||||
End Sub
|
||||
|
||||
|
||||
Sub SetOVERWRITEToAlways()
|
||||
iGeneralOverwrite = SBOVERWRITEALWAYS
|
||||
DlgOverwrite.EndExecute()
|
||||
End Sub
|
||||
|
||||
|
||||
Sub SetOVERWRITEToNever()
|
||||
iGeneralOverwrite = SBOVERWRITENEVER
|
||||
DlgOverwrite.EndExecute()
|
||||
End Sub
|
||||
</script:module>
|
||||
Reference in New Issue
Block a user