1<?xml version="1.0" encoding="UTF-8"?> 2<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> 3<!--*********************************************************** 4 * 5 * Licensed to the Apache Software Foundation (ASF) under one 6 * or more contributor license agreements. See the NOTICE file 7 * distributed with this work for additional information 8 * regarding copyright ownership. The ASF licenses this file 9 * to you under the Apache License, Version 2.0 (the 10 * "License"); you may not use this file except in compliance 11 * with the License. You may obtain a copy of the License at 12 * 13 * http://www.apache.org/licenses/LICENSE-2.0 14 * 15 * Unless required by applicable law or agreed to in writing, 16 * software distributed under the License is distributed on an 17 * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 18 * KIND, either express or implied. See the License for the 19 * specific language governing permissions and limitations 20 * under the License. 21 * 22 ***********************************************************--> 23<script:module xmlns:script="http://openoffice.org/2000/script" script:name="ModuleControls" script:language="StarBasic">Option Explicit 24 25Public DlgOverwrite as Object 26Public Const SBOVERWRITEUNDEFINED as Integer = 0 27Public Const SBOVERWRITECANCEL as Integer = 2 28Public Const SBOVERWRITEQUERY as Integer = 7 29Public Const SBOVERWRITEALWAYS as Integer = 6 30Public Const SBOVERWRITENEVER as Integer = 8 31Public iGeneralOverwrite as Integer 32 33 34 35' Accepts the name of a control and returns the respective control model as object 36' The Container can either be a whole document or a specific sheet of a Calc-Document 37' 'CName' is the name of the Control 38Function getControlModel(oContainer as Object, CName as String) 39Dim aForm, oForms as Object 40Dim i as Integer 41 oForms = oContainer.Drawpage.GetForms 42 For i = 0 To oForms.Count-1 43 aForm = oForms.GetbyIndex(i) 44 If aForm.HasByName(CName) Then 45 GetControlModel = aForm.GetbyName(CName) 46 Exit Function 47 End If 48 Next i 49 Msgbox("No Control with the name '" & CName & "' found" , 16, GetProductName()) 50End Function 51 52 53 54' Gets the Shape of a Control( e. g. to reset the size or Position of the control 55' Parameters: 56' The 'oContainer' is the Document or a specific sheet of a Calc - Document 57' 'CName' is the Name of the Control 58Function GetControlShape(oContainer as Object,CName as String) 59Dim i as integer 60Dim aShape as Object 61 For i = 0 to oContainer.DrawPage.Count-1 62 aShape = oContainer.DrawPage(i) 63 If HasUnoInterfaces(aShape, "com.sun.star.drawing.XControlShape") then 64 If ashape.Control.Name = CName then 65 GetControlShape = aShape 66 exit Function 67 End If 68 End If 69 Next 70End Function 71 72 73' Returns the View of a Control 74' Parameters: 75' The 'oContainer' is the Document or a specific sheet of a Calc - Document 76' The 'oController' is always directly attached to the Document 77' 'CName' is the Name of the Control 78Function getControlView(oContainer , oController as Object, CName as String) as Object 79Dim aForm, oForms, oControlModel as Object 80Dim i as Integer 81 oForms = oContainer.DrawPage.Forms 82 For i = 0 To oForms.Count-1 83 aForm = oforms.GetbyIndex(i) 84 If aForm.HasByName(CName) Then 85 oControlModel = aForm.GetbyName(CName) 86 GetControlView = oController.GetControl(oControlModel) 87 Exit Function 88 End If 89 Next i 90 Msgbox("No Control with the name '" & CName & "' found" , 16, GetProductName()) 91End Function 92 93 94 95' Parameters: 96' The 'oContainer' is the Document or a specific sheet of a Calc - Document 97' 'CName' is the Name of the Control 98Function DisposeControl(oContainer as Object, CName as String) as Boolean 99Dim aControl as Object 100 101 aControl = GetControlModel(oContainer,CName) 102 If not IsNull(aControl) Then 103 aControl.Dispose() 104 DisposeControl = True 105 Else 106 DisposeControl = False 107 End If 108End Function 109 110 111' Returns a sequence of a group of controls like option buttons or checkboxes 112' The 'oContainer' is the Document or a specific sheet of a Calc - Document 113' 'sGroupName' is the Name of the Controlgroup 114Function GetControlGroupModel(oContainer as Object, sGroupName as String ) 115Dim aForm, oForms As Object 116Dim aControlModel() As Object 117Dim i as integer 118 119 oForms = oContainer.DrawPage.Forms 120 For i = 0 To oForms.Count-1 121 aForm = oForms(i) 122 If aForm.HasbyName(sGroupName) Then 123 aForm.GetGroupbyName(sGroupName,aControlModel) 124 GetControlGroupModel = aControlModel 125 Exit Function 126 End If 127 Next i 128 Msgbox("No Controlgroup with the name '" & sGroupName & "' found" , 16, GetProductName()) 129End Function 130 131 132' Returns the Referencevalue of a group of e.g. option buttons or check boxes 133' 'oControlGroup' is a sequence of the Control objects 134Function GetRefValue(oControlGroup() as Object) 135Dim i as Integer 136 For i = 0 To Ubound(oControlGroup()) 137' oControlGroup(i).DefaultState = oControlGroup(i).State 138 If oControlGroup(i).State Then 139 GetRefValue = oControlGroup(i).RefValue 140 exit Function 141 End If 142 Next 143 GetRefValue() = -1 144End Function 145 146 147Function GetRefValueOfControlGroup(oContainer as Object, GroupName as String) 148Dim oOptGroup() as Object 149Dim iRef as Integer 150 oOptGroup() = GetControlGroupModel(oContainer, GroupName) 151 iRef = GetRefValue(oOptGroup()) 152 GetRefValueofControlGroup = iRef 153End Function 154 155 156Function GetOptionGroupValue(oContainer as Object, OptGroupName as String) as Boolean 157Dim oRulesOptions() as Object 158 oRulesOptions() = GetControlGroupModel(oContainer, OptGroupName) 159 GetOptionGroupValue = oRulesOptions(0).State 160End Function 161 162 163 164Function WriteOptValueToCell(oSheet as Object, OptGroupName as String, iCol as Integer, iRow as Integer) as Boolean 165Dim bOptValue as Boolean 166Dim oCell as Object 167 bOptValue = GetOptionGroupValue(oSheet, OptGroupName) 168 oCell = oSheet.GetCellByPosition(iCol, iRow) 169 oCell.SetValue(ABS(CInt(bOptValue))) 170 WriteOptValueToCell() = bOptValue 171End Function 172 173 174Function LoadDialog(Libname as String, DialogName as String, Optional oLibContainer) 175Dim oLib as Object 176Dim oLibDialog as Object 177Dim oRuntimeDialog as Object 178 If IsMissing(oLibContainer ) then 179 oLibContainer = DialogLibraries 180 End If 181 oLibContainer.LoadLibrary(LibName) 182 oLib = oLibContainer.GetByName(Libname) 183 oLibDialog = oLib.GetByName(DialogName) 184 oRuntimeDialog = CreateUnoDialog(oLibDialog) 185 LoadDialog() = oRuntimeDialog 186End Function 187 188 189Sub GetFolderName(oRefModel as Object) 190Dim oFolderDialog as Object 191Dim iAccept as Integer 192Dim sPath as String 193Dim InitPath as String 194Dim RefControlName as String 195Dim oUcb as object 196 'Note: The following services have to be called in the following order 197 ' because otherwise Basic does not remove the FileDialog Service 198 oFolderDialog = CreateUnoService("com.sun.star.ui.dialogs.FolderPicker") 199 oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess") 200 InitPath = ConvertToUrl(oRefModel.Text) 201 If InitPath = "" Then 202 InitPath = GetPathSettings("Work") 203 End If 204 If oUcb.Exists(InitPath) Then 205 oFolderDialog.SetDisplayDirectory(InitPath) 206 End If 207 iAccept = oFolderDialog.Execute() 208 If iAccept = 1 Then 209 sPath = oFolderDialog.GetDirectory() 210 If oUcb.Exists(sPath) Then 211 oRefModel.Text = ConvertFromUrl(sPath) 212 End If 213 End If 214End Sub 215 216 217Sub GetFileName(oRefModel as Object, Filternames()) 218Dim oFileDialog as Object 219Dim iAccept as Integer 220Dim sPath as String 221Dim InitPath as String 222Dim RefControlName as String 223Dim oUcb as object 224'Dim ListAny(0) 225 'Note: The following services have to be called in the following order 226 ' because otherwise Basic does not remove the FileDialog Service 227 oFileDialog = CreateUnoService("com.sun.star.ui.dialogs.FilePicker") 228 oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess") 229 'ListAny(0) = com.sun.star.ui.dialogs.TemplateDescription.FILEOPEN_SIMPLE 230 'oFileDialog.initialize(ListAny()) 231 AddFiltersToDialog(FilterNames(), oFileDialog) 232 InitPath = ConvertToUrl(oRefModel.Text) 233 If InitPath = "" Then 234 InitPath = GetPathSettings("Work") 235 End If 236 If oUcb.Exists(InitPath) Then 237 oFileDialog.SetDisplayDirectory(InitPath) 238 End If 239 iAccept = oFileDialog.Execute() 240 If iAccept = 1 Then 241 sPath = oFileDialog.Files(0) 242 If oUcb.Exists(sPath) Then 243 oRefModel.Text = ConvertFromUrl(sPath) 244 End If 245 End If 246 oFileDialog.Dispose() 247End Sub 248 249 250Function StoreDocument(oDocument as Object, FilterNames() as String, DefaultName as String, DisplayDirectory as String, Optional iAddProcedure as Integer) as String 251Dim NoArgs() as New com.sun.star.beans.PropertyValue 252Dim oStoreProperties(0) as New com.sun.star.beans.PropertyValue 253Dim oStoreDialog as Object 254Dim iAccept as Integer 255Dim sPath as String 256Dim ListAny(0) as Long 257Dim UIFilterName as String 258Dim FilterName as String 259Dim FilterIndex as Integer 260 ListAny(0) = com.sun.star.ui.dialogs.TemplateDescription.FILESAVE_AUTOEXTENSION_PASSWORD 261 oStoreDialog = CreateUnoService("com.sun.star.ui.dialogs.FilePicker") 262 oStoreDialog.Initialize(ListAny()) 263 AddFiltersToDialog(FilterNames(), oStoreDialog) 264 oStoreDialog.SetDisplayDirectory(DisplayDirectory) 265 oStoreDialog.SetDefaultName(DefaultName) 266 oStoreDialog.setValue(com.sun.star.ui.dialogs.ExtendedFilePickerElementIds.CHECKBOX_AUTOEXTENSION,0, true) 267 268 iAccept = oStoreDialog.Execute() 269 If iAccept = 1 Then 270 sPath = oStoreDialog.Files(0) 271 UIFilterName = oStoreDialog.GetCurrentFilter() 272 FilterIndex = IndexInArray(UIFilterName, FilterNames()) 273 FilterName = FilterNames(FilterIndex,2) 274 If Not IsMissing(iAddProcedure) Then 275 Select Case iAddProcedure 276 Case 1 277 CommitLastDocumentChanges(sPath) 278 End Select 279 End If 280 On Local Error Goto NOSAVING 281 If FilterName = "" Then 282 ' Todo: Catch the case that a document that has to be overwritten is writeportected (e.g. it is open) 283 oDocument.StoreAsUrl(sPath, NoArgs()) 284 Else 285 oStoreProperties(0).Name = "FilterName" 286 oStoreProperties(0).Value = FilterName 287 oDocument.StoreAsUrl(sPath, oStoreProperties()) 288 End If 289 End If 290 oStoreDialog.dispose() 291 StoreDocument() = sPath 292 Exit Function 293NOSAVING: 294 If Err <> 0 Then 295' Msgbox("Document cannot be saved under '" & ConvertFromUrl(sPath) & "'", 48, GetProductName()) 296 sPath = "" 297 oStoreDialog.dispose() 298 Resume NOERROR 299 NOERROR: 300 End If 301End Function 302 303 304Sub AddFiltersToDialog(FilterNames() as String, oDialog as Object) 305Dim i as Integer 306Dim MaxIndex as Integer 307Dim ViewFiltername as String 308Dim oProdNameAccess as Object 309Dim sProdName as String 310 oProdNameAccess = GetRegistryKeyContent("org.openoffice.Setup/Product") 311 sProdName = oProdNameAccess.getByName("ooName") 312 MaxIndex = Ubound(FilterNames(), 1) 313 For i = 0 To MaxIndex 314 Filternames(i,0) = ReplaceString(Filternames(i,0), sProdName,"%productname%") 315 oDialog.AppendFilter(FilterNames(i,0), FilterNames(i,1)) 316 Next i 317 oDialog.SetCurrentFilter(FilterNames(0,0) 318End Sub 319 320 321Sub SwitchMousePointer(oWindowPeer as Object, bDoEnable as Boolean) 322Dim oWindowPointer as Object 323 oWindowPointer = CreateUnoService("com.sun.star.awt.Pointer") 324 If bDoEnable Then 325 oWindowPointer.SetType(com.sun.star.awt.SystemPointer.ARROW) 326 Else 327 oWindowPointer.SetType(com.sun.star.awt.SystemPointer.WAIT) 328 End If 329 oWindowPeer.SetPointer(oWindowPointer) 330End Sub 331 332 333Sub ShowOverwriteAllDialog(FilePath as String, sTitle as String) 334Dim QueryString as String 335Dim LocRetValue as Integer 336Dim lblYes as String 337Dim lblNo as String 338Dim lblYesToAll as String 339Dim lblCancel as String 340Dim OverwriteModel as Object 341 If InitResources(GetProductName(), "dbw") Then 342 QueryString = GetResText(507) 343 QueryString = ReplaceString(QueryString, ConvertFromUrl(FilePath), "<PATH>") 344 If Len(QueryString) > 190 Then 345 QueryString = DeleteStr(QueryString, ".<BR>") 346 End If 347 QueryString = ReplaceString(QueryString, chr(13), "<BR>") 348 lblYes = GetResText(508) 349 lblYesToAll = GetResText(509) 350 lblNo = GetResText(510) 351 lblCancel = GetResText(511) 352 DlgOverwrite = LoadDialog("Tools", "DlgOverwriteAll") 353 DlgOverwrite.Title = sTitle 354 OverwriteModel = DlgOverwrite.Model 355 OverwriteModel.cmdYes.Label = lblYes 356 OverwriteModel.cmdYesToAll.Label = lblYesToAll 357 OverwriteModel.cmdNo.Label = lblNo 358 OverwriteModel.cmdCancel.Label = lblCancel 359 OverwriteModel.lblQueryforSave.Label = QueryString 360 OverwriteModel.cmdNo.DefaultButton = True 361 DlgOverwrite.GetControl("cmdNo").SetFocus() 362 iGeneralOverwrite = 999 363 LocRetValue = DlgOverwrite.execute() 364 If iGeneralOverwrite = 999 Then 365 iGeneralOverwrite = SBOVERWRITECANCEL 366 End If 367 DlgOverwrite.dispose() 368 Else 369 iGeneralOverwrite = SBOVERWRITECANCEL 370 End If 371End Sub 372 373 374Sub SetOVERWRITEToQuery() 375 iGeneralOverwrite = SBOVERWRITEQUERY 376 DlgOverwrite.EndExecute() 377End Sub 378 379 380Sub SetOVERWRITEToAlways() 381 iGeneralOverwrite = SBOVERWRITEALWAYS 382 DlgOverwrite.EndExecute() 383End Sub 384 385 386Sub SetOVERWRITEToNever() 387 iGeneralOverwrite = SBOVERWRITENEVER 388 DlgOverwrite.EndExecute() 389End Sub 390</script:module> 391