diff options
Diffstat (limited to 'wizards/source/tools/ModuleControls.xba')
| -rw-r--r-- | wizards/source/tools/ModuleControls.xba | 387 |
1 files changed, 387 insertions, 0 deletions
diff --git a/wizards/source/tools/ModuleControls.xba b/wizards/source/tools/ModuleControls.xba new file mode 100644 index 000000000..059956cb1 --- /dev/null +++ b/wizards/source/tools/ModuleControls.xba @@ -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> |