diff options
Diffstat (limited to 'wizards/source/tools/ModuleControls.xba')
| -rw-r--r-- | wizards/source/tools/ModuleControls.xba | 370 |
1 files changed, 0 insertions, 370 deletions
diff --git a/wizards/source/tools/ModuleControls.xba b/wizards/source/tools/ModuleControls.xba deleted file mode 100644 index dc5ef02a5..000000000 --- a/wizards/source/tools/ModuleControls.xba +++ /dev/null @@ -1,370 +0,0 @@ -<?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 - -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 writeportected (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(), "dbw") Then - QueryString = GetResText(507) - 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(508) - lblYesToAll = GetResText(509) - lblNo = GetResText(510) - lblCancel = GetResText(511) - 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>
\ No newline at end of file |