wizards/source/tools/ModuleControls.xba

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