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 <script:module xmlns:script="http://openoffice.org/2000/script" script:name="ModuleControls" script:language="StarBasic">Option Explicit
   4
   5 Public DlgOverwrite as Object
   6 Public Const SBOVERWRITEUNDEFINED as Integer = 0
   7 Public Const SBOVERWRITECANCEL as Integer = 2
   8 Public Const SBOVERWRITEQUERY as Integer = 7
   9 Public Const SBOVERWRITEALWAYS as Integer = 6
  10 Public Const SBOVERWRITENEVER as Integer = 8
  11 Public iGeneralOverwrite as Integer
  12
  13
  14
  15 &apos; Accepts the name of a control and returns the respective control model as object
  16 &apos; The Container can either be a whole document or a specific sheet of a Calc-Document
  17 &apos; &apos;CName&apos; is the name of the Control
  18 Function getControlModel(oContainer as Object, CName as String)
  19 Dim aForm, oForms as Object
  20 Dim 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(&quot;No Control with the name &apos;&quot; &amp; CName &amp; &quot;&apos; found&quot; , 16, GetProductName())
  30 End Function
  31
  32
  33
  34 &apos; Gets the Shape of a Control( e. g. to reset the size or Position of the control
  35 &apos; Parameters:
  36 &apos; The &apos;oContainer&apos; is the Document or a specific sheet of a Calc - Document
  37 &apos; &apos;CName&apos; is the Name of the Control
  38 Function GetControlShape(oContainer as Object,CName as String)
  39 Dim i as integer
  40 Dim aShape as Object
  41         For i = 0 to oContainer.DrawPage.Count-1
  42                 aShape = oContainer.DrawPage(i)
  43                 If HasUnoInterfaces(aShape, &quot;com.sun.star.drawing.XControlShape&quot;) then
  44                         If ashape.Control.Name = CName then
  45                                 GetControlShape = aShape
  46                                 exit Function
  47                         End If
  48                 End If
  49         Next
  50 End Function
  51
  52
  53 &apos; Returns the View of a Control
  54 &apos; Parameters:
  55 &apos; The &apos;oContainer&apos; is the Document or a specific sheet of a Calc - Document
  56 &apos; The &apos;oController&apos; is always directly attached to the Document
  57 &apos; &apos;CName&apos; is the Name of the Control
  58 Function getControlView(oContainer , oController as Object, CName as String) as Object
  59 Dim aForm, oForms, oControlModel as Object
  60 Dim 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(&quot;No Control with the name &apos;&quot; &amp; CName &amp; &quot;&apos; found&quot; , 16, GetProductName())
  71 End Function
  72
  73
  74
  75 &apos; Parameters:
  76 &apos; The &apos;oContainer&apos; is the Document or a specific sheet of a Calc - Document
  77 &apos; &apos;CName&apos; is the Name of the Control
  78 Function DisposeControl(oContainer as Object, CName as String) as Boolean
  79 Dim 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
  88 End Function
  89
  90
  91 &apos; Returns a sequence of a group of controls like option buttons or checkboxes
  92 &apos; The &apos;oContainer&apos; is the Document or a specific sheet of a Calc - Document
  93 &apos; &apos;sGroupName&apos; is the Name of the Controlgroup
  94 Function GetControlGroupModel(oContainer as Object, sGroupName as String )
  95 Dim aForm, oForms As Object
  96 Dim aControlModel() As Object
  97 Dim 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(&quot;No Controlgroup with the name &apos;&quot; &amp; sGroupName &amp; &quot;&apos; found&quot; , 16, GetProductName())
 109 End Function
 110
 111
 112 &apos; Returns the Referencevalue of a group of e.g. option buttons or check boxes
 113 &apos; &apos;oControlGroup&apos; is a sequence of the Control objects
 114 Function GetRefValue(oControlGroup() as Object)
 115 Dim i as Integer
 116         For i = 0 To Ubound(oControlGroup())
 117 &apos;          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
 124 End Function
 125
 126
 127 Function GetRefValueOfControlGroup(oContainer as Object, GroupName as String)
 128 Dim oOptGroup() as Object
 129 Dim iRef as Integer
 130         oOptGroup() = GetControlGroupModel(oContainer, GroupName)
 131         iRef = GetRefValue(oOptGroup())
 132         GetRefValueofControlGroup = iRef
 133 End Function
 134
 135
 136 Function GetOptionGroupValue(oContainer as Object, OptGroupName as String) as Boolean
 137 Dim oRulesOptions() as Object
 138         oRulesOptions() = GetControlGroupModel(oContainer, OptGroupName)
 139         GetOptionGroupValue = oRulesOptions(0).State
 140 End Function
 141
 142
 143
 144 Function WriteOptValueToCell(oSheet as Object, OptGroupName as String, iCol as Integer, iRow as Integer) as Boolean
 145 Dim bOptValue as Boolean
 146 Dim oCell as Object
 147         bOptValue = GetOptionGroupValue(oSheet, OptGroupName)
 148         oCell = oSheet.GetCellByPosition(iCol, iRow)
 149         oCell.SetValue(ABS(CInt(bOptValue)))
 150         WriteOptValueToCell() = bOptValue
 151 End Function
 152
 153
 154 Function LoadDialog(Libname as String, DialogName as String, Optional oLibContainer)
 155 Dim oLib as Object
 156 Dim oLibDialog as Object
 157 Dim 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
 166 End Function
 167
 168
 169 Sub GetFolderName(oRefModel as Object)
 170 Dim oFolderDialog as Object
 171 Dim iAccept as Integer
 172 Dim sPath as String
 173 Dim InitPath as String
 174 Dim RefControlName as String
 175 Dim oUcb as object
 176         &apos;Note: The following services have to be called in the following order
 177         &apos; because otherwise Basic does not remove the FileDialog Service
 178         oFolderDialog = CreateUnoService(&quot;com.sun.star.ui.dialogs.FolderPicker&quot;)
 179         oUcb = createUnoService(&quot;com.sun.star.ucb.SimpleFileAccess&quot;)
 180         InitPath = ConvertToUrl(oRefModel.Text)
 181         If InitPath = &quot;&quot; Then
 182                 InitPath = GetPathSettings(&quot;Work&quot;)
 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
 194 End Sub
 195
 196
 197 Sub GetFileName(oRefModel as Object, Filternames())
 198 Dim oFileDialog as Object
 199 Dim iAccept as Integer
 200 Dim sPath as String
 201 Dim InitPath as String
 202 Dim RefControlName as String
 203 Dim oUcb as object
 204 &apos;Dim ListAny(0)
 205         &apos;Note: The following services have to be called in the following order
 206         &apos; because otherwise Basic does not remove the FileDialog Service
 207         oFileDialog = CreateUnoService(&quot;com.sun.star.ui.dialogs.FilePicker&quot;)
 208         oUcb = createUnoService(&quot;com.sun.star.ucb.SimpleFileAccess&quot;)
 209         &apos;ListAny(0) = com.sun.star.ui.dialogs.TemplateDescription.FILEOPEN_SIMPLE
 210         &apos;oFileDialog.initialize(ListAny())
 211         AddFiltersToDialog(FilterNames(), oFileDialog)
 212         InitPath = ConvertToUrl(oRefModel.Text)
 213         If InitPath = &quot;&quot; Then
 214                 InitPath = GetPathSettings(&quot;Work&quot;)
 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()
 227 End Sub
 228
 229
 230 Function StoreDocument(oDocument as Object, FilterNames() as String, DefaultName as String, DisplayDirectory as String, Optional iAddProcedure as Integer) as String
 231 Dim NoArgs() as New com.sun.star.beans.PropertyValue
 232 Dim oStoreProperties(0) as New com.sun.star.beans.PropertyValue
 233 Dim oStoreDialog as Object
 234 Dim iAccept as Integer
 235 Dim sPath as String
 236 Dim ListAny(0) as Long
 237 Dim UIFilterName as String
 238 Dim FilterName as String
 239 Dim FilterIndex as Integer
 240         ListAny(0) = com.sun.star.ui.dialogs.TemplateDescription.FILESAVE_AUTOEXTENSION_PASSWORD
 241         oStoreDialog = CreateUnoService(&quot;com.sun.star.ui.dialogs.FilePicker&quot;)
 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 = &quot;&quot;  Then
 262                         &apos; 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 = &quot;FilterName&quot;
 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
 273 NOSAVING:
 274         If Err &lt;&gt; 0 Then
 275 &apos;          Msgbox(&quot;Document cannot be saved under &apos;&quot; &amp; ConvertFromUrl(sPath) &amp; &quot;&apos;&quot;, 48, GetProductName())
 276                 sPath = &quot;&quot;
 277                 oStoreDialog.dispose()
 278                 Resume NOERROR
 279                 NOERROR:
 280         End If
 281 End Function
 282
 283
 284 Sub AddFiltersToDialog(FilterNames() as String, oDialog as Object)
 285 Dim i as Integer
 286 Dim MaxIndex as Integer
 287 Dim ViewFiltername as String
 288 Dim oProdNameAccess as Object
 289 Dim sProdName as String
 290         oProdNameAccess = GetRegistryKeyContent(&quot;org.openoffice.Setup/Product&quot;)
 291         sProdName = oProdNameAccess.getByName(&quot;ooName&quot;)
 292         MaxIndex = Ubound(FilterNames(), 1)
 293         For i = 0 To MaxIndex
 294                 Filternames(i,0) = ReplaceString(Filternames(i,0), sProdName,&quot;%productname%&quot;)
 295                 oDialog.AppendFilter(FilterNames(i,0), FilterNames(i,1))
 296         Next i
 297         oDialog.SetCurrentFilter(FilterNames(0,0)
 298 End Sub
 299
 300
 301 Sub SwitchMousePointer(oWindowPeer as Object, bDoEnable as Boolean)
 302 Dim oWindowPointer as Object
 303         oWindowPointer = CreateUnoService(&quot;com.sun.star.awt.Pointer&quot;)
 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)
 310 End Sub
 311
 312
 313 Sub ShowOverwriteAllDialog(FilePath as String, sTitle as String)
 314 Dim QueryString as String
 315 Dim LocRetValue as Integer
 316 Dim lblYes as String
 317 Dim lblNo as String
 318 Dim lblYesToAll as String
 319 Dim lblCancel as String
 320 Dim OverwriteModel as Object
 321         If InitResources(GetProductName(), &quot;dbw&quot;) Then
 322                 QueryString = GetResText(507)
 323                 QueryString = ReplaceString(QueryString, ConvertFromUrl(FilePath), &quot;&lt;PATH&gt;&quot;)
 324                 If Len(QueryString) &gt; 190 Then
 325                         QueryString = DeleteStr(QueryString, &quot;.&lt;BR&gt;&quot;)
 326                 End If
 327                 QueryString = ReplaceString(QueryString, chr(13), &quot;&lt;BR&gt;&quot;)
 328                 lblYes = GetResText(508)
 329                 lblYesToAll = GetResText(509)
 330                 lblNo = GetResText(510)
 331                 lblCancel = GetResText(511)
 332                 DlgOverwrite = LoadDialog(&quot;Tools&quot;, &quot;DlgOverwriteAll&quot;)
 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(&quot;cmdNo&quot;).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
 351 End Sub
 352
 353
 354 Sub SetOVERWRITEToQuery()
 355         iGeneralOverwrite = SBOVERWRITEQUERY
 356         DlgOverwrite.EndExecute()
 357 End Sub
 358
 359
 360 Sub SetOVERWRITEToAlways()
 361         iGeneralOverwrite = SBOVERWRITEALWAYS
 362         DlgOverwrite.EndExecute()
 363 End Sub
 364
 365
 366 Sub SetOVERWRITEToNever()
 367         iGeneralOverwrite = SBOVERWRITENEVER
 368         DlgOverwrite.EndExecute()
 369 End Sub
 370 </script:module>