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