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