wizards/source/access2base/CommandBar.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="CommandBar" script:language="StarBasic">REM =======================================================================================================================
   4 REM ===                                 The Access2Base library is a part of the LibreOffice project.                                                                   ===
   5 REM ===                                 Full documentation is available on http://www.access2base.com                                                                   ===
   6 REM =======================================================================================================================
   7
   8 Option Compatible
   9 Option ClassModule
  10
  11 Option Explicit
  12
  13 REM -----------------------------------------------------------------------------------------------------------------------
  14 REM --- CLASS ROOT FIELDS                                                                                                                                                                                       ---
  15 REM -----------------------------------------------------------------------------------------------------------------------
  16
  17 Private _Type                   As String               &apos;  Must be COMMANDBAR
  18 Private _Name                   As String
  19 Private _ResourceURL    As String
  20 Private _Window                 As Object               &apos;  com.sun.star.frame.XFrame
  21 Private _Module                 As String
  22 Private _Toolbar                As Object
  23 Private _BarBuiltin             As Integer              &apos;  1 = builtin, 2 = custom stored in LO/AOO (Base), 3 = custom stored in document (Form)
  24 Private _BarType                As Integer              &apos;  See msoBarTypeXxx constants
  25
  26 REM -----------------------------------------------------------------------------------------------------------------------
  27 REM --- CONSTRUCTORS / DESTRUCTORS                                                                                                                                                                      ---
  28 REM -----------------------------------------------------------------------------------------------------------------------
  29 Private Sub Class_Initialize()
  30         _Type = OBJCOMMANDBAR
  31         _Name = &quot;&quot;
  32         _ResourceURL = &quot;&quot;
  33         Set _Window = Nothing
  34         _Module = &quot;&quot;
  35         Set _Toolbar = Nothing
  36         _BarBuiltin = 0
  37         _BarType = -1
  38 End Sub         &apos;  Constructor
  39
  40 REM -----------------------------------------------------------------------------------------------------------------------
  41 Private Sub Class_Terminate()
  42         On Local Error Resume Next
  43         Call Class_Initialize()
  44 End Sub         &apos;  Destructor
  45
  46 REM -----------------------------------------------------------------------------------------------------------------------
  47 Public Sub Dispose()
  48         Call Class_Terminate()
  49 End Sub         &apos;  Explicit destructor
  50
  51 REM -----------------------------------------------------------------------------------------------------------------------
  52 REM --- CLASS GET/LET/SET PROPERTIES                                                                                                                                                            ---
  53 REM -----------------------------------------------------------------------------------------------------------------------
  54
  55 REM -----------------------------------------------------------------------------------------------------------------------
  56 Property Get BuiltIn() As Boolean
  57         BuiltIn = _PropertyGet(&quot;BuiltIn&quot;)
  58 End Property            &apos;  BuiltIn (get)
  59
  60 REM -----------------------------------------------------------------------------------------------------------------------
  61 Property Get Name() As String
  62         Name = _PropertyGet(&quot;Name&quot;)
  63 End Property            &apos;  Name (get)
  64
  65 Public Function pName() As String               &apos;  For compatibility with &lt; V0.9.0
  66         pName = _PropertyGet(&quot;Name&quot;)
  67 End Function            &apos;  pName (get)
  68
  69 REM -----------------------------------------------------------------------------------------------------------------------
  70 Property Get ObjectType() As String
  71         ObjectType = _PropertyGet(&quot;ObjectType&quot;)
  72 End Property            &apos;  ObjectType (get)
  73
  74 REM -----------------------------------------------------------------------------------------------------------------------
  75 Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
  76 &apos;  Return
  77 &apos;          a Collection object if pvIndex absent
  78 &apos;          a Property object otherwise
  79
  80 Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String
  81         vPropertiesList = _PropertiesList()
  82         sObject = Utils._PCase(_Type)
  83         If IsMissing(pvIndex) Then
  84                 vProperty = PropertiesGet._Properties(sObject, _Name, vPropertiesList)
  85         Else
  86                 vProperty = PropertiesGet._Properties(sObject, _Name, vPropertiesList, pvIndex)
  87                 vProperty._Value = _PropertyGet(vPropertiesList(pvIndex))
  88         End If
  89
  90 Exit_Function:
  91         Set Properties = vProperty
  92         Exit Function
  93 End Function    &apos;  Properties
  94
  95 REM -----------------------------------------------------------------------------------------------------------------------
  96 Property Get Visible() As Variant
  97         Visible = _PropertyGet(&quot;Visible&quot;)
  98 End Property            &apos;  Visible (get)
  99
 100 Property Let Visible(ByVal pvValue As Variant)
 101         Call _PropertySet(&quot;Visible&quot;, pvValue)
 102 End Property            &apos;  Visible (set)
 103
 104 REM -----------------------------------------------------------------------------------------------------------------------
 105 REM --- CLASS METHODS                                                                                                                                                                                           ---
 106 REM -----------------------------------------------------------------------------------------------------------------------
 107
 108 REM -----------------------------------------------------------------------------------------------------------------------
 109 Public Function CommandBarControls(Optional ByVal pvIndex As Variant) As Variant
 110 &apos;  Return an object of type CommandBarControl indicated by its index
 111 &apos;  Index is different from UNO index: separators do not count
 112 &apos;  If no pvIndex argument, return a Collection type
 113
 114         If _ErrorHandler() Then On Local Error Goto Error_Function
 115 Const cstThisSub = &quot;CommandBar.CommandBarControls&quot;
 116         Utils._SetCalledSub(cstThisSub)
 117
 118 Dim oLayout As Object, vElements() As Variant, iIndexToolbar As Integer, oToolbar As Object
 119 Dim i As Integer, iItemsCount As Integer, oSettings As Object, vItem() As Variant, bSeparator As Boolean
 120 Dim oObject As Object
 121
 122         Set oObject = Nothing
 123         If Not IsMissing(pvIndex) Then
 124                 If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric()) Then Goto Exit_Function
 125                 If pvIndex &lt; 0 Then Goto Trace_IndexError
 126         End If
 127
 128         Select Case _BarType
 129                 Case msoBarTypeNormal, msoBarTypeMenuBar
 130                 Case Else       :       Goto Error_NotApplicable                                &apos;  Status bar not supported
 131         End Select
 132
 133         Set oLayout = _Window.LayoutManager
 134         vElements = oLayout.getElements()
 135         iIndexToolbar = _FindElement(vElements())
 136         If iIndexToolbar &lt; 0 Then Goto Error_NotApplicable                   &apos;  Toolbar not visible
 137         Set oToolbar = vElements(iIndexToolbar)
 138
 139         iItemsCount = 0
 140         Set oSettings = oToolbar.getSettings(False)
 141
 142         bSeparator = False
 143         For i = 0 To oSettings.getCount() - 1
 144                 Set vItem() = oSettings.getByIndex(i)
 145                 If _GetPropertyValue(vItem, &quot;Type&quot;, 1) &lt;&gt; 1 Then                &apos;  Type = 1 indicates separator
 146                         iItemsCount = iItemsCount + 1
 147                         If Not IsMissing(pvIndex) Then
 148                                 If pvIndex = iItemsCount - 1 Then
 149                                         Set oObject = New CommandBarControl
 150                                         With oObject
 151                                                 ._ParentCommandBarName = _Name
 152                                                 ._ParentCommandBar = oToolbar
 153                                                 ._ParentBuiltin = ( _BarBuiltin = 1 )
 154                                                 ._Element = vItem()
 155                                                 ._InternalIndex = i
 156                                                 ._Index = iItemsCount                                   &apos;  Indexes start at 1
 157                                                 ._BeginGroup = bSeparator
 158                                         End With
 159                                 End If
 160                                 bSeparator = False
 161                         End If
 162                 Else
 163                         bSeparator = True
 164                 End If
 165         Next i
 166
 167         If IsNull(oObject) Then
 168                 Select Case True
 169                         Case IsMissing(pvIndex)
 170                                 Set oObject = New Collect
 171                                 oObject._CollType = COLLCOMMANDBARCONTROLS
 172                                 oObject._ParentType = OBJCOMMANDBAR
 173                                 oObject._ParentName = _Name
 174                                 oObject._Count = iItemsCount
 175                         Case Else               &apos;  pvIndex is numeric
 176                                 Goto Trace_IndexError
 177                 End Select
 178         End If
 179
 180 Exit_Function:
 181         Set CommandBarControls = oObject
 182         Set oObject = Nothing
 183         Utils._ResetCalledSub(cstThisSub)
 184         Exit Function
 185 Error_Function:
 186         TraceError(TRACEABORT, Err, cstThisSub, Erl)
 187         GoTo Exit_Function
 188 Trace_IndexError:
 189         TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0)
 190         Goto Exit_Function
 191 Error_NotApplicable:
 192         TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub)
 193         Goto Exit_Function
 194 End Function    &apos;  CommandBarControls              V1,3,0
 195
 196 REM -----------------------------------------------------------------------------------------------------------------------
 197 Public Function Controls(Optional ByVal pvIndex As Variant) As Variant
 198 &apos;  Alias for CommandBarControls (VBA)
 199
 200         If _ErrorHandler() Then On Local Error Goto Error_Function
 201 Const cstThisSub = &quot;CommandBar.Controls&quot;
 202         Utils._SetCalledSub(cstThisSub)
 203
 204 Dim oObject As Object
 205
 206         If IsMissing(pvIndex) Then Set oObject = CommandBarControls() Else Set oObject = CommandBarControls(pvIndex)
 207
 208 Exit_Function:
 209         Set Controls = oObject
 210         Set oObject = Nothing
 211         Utils._ResetCalledSub(cstThisSub)
 212         Exit Function
 213 Error_Function:
 214         TraceError(TRACEABORT, Err, cstThisSub, Erl)
 215         GoTo Exit_Function
 216 End Function    &apos;  Controls                V1,3,0
 217
 218 REM -----------------------------------------------------------------------------------------------------------------------
 219 Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
 220 &apos;  Return property value of psProperty property name
 221
 222         Utils._SetCalledSub(&quot;CommandBar.getProperty&quot;)
 223         If IsMissing(pvProperty) Then Call _TraceArguments()
 224         getProperty = _PropertyGet(pvProperty)
 225         Utils._ResetCalledSub(&quot;CommandBar.getProperty&quot;)
 226
 227 End Function            &apos;  getProperty
 228
 229 REM -----------------------------------------------------------------------------------------------------------------------
 230 Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
 231 &apos;  Return True if object has a valid property called pvProperty (case-insensitive comparison !)
 232
 233         If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty)
 234         Exit Function
 235
 236 End Function    &apos;  hasProperty
 237
 238 REM -----------------------------------------------------------------------------------------------------------------------
 239 Public Function Reset() As Boolean
 240 &apos;  Reset a whole command bar to its initial values
 241
 242         If _ErrorHandler() Then On Local Error Goto Error_Function
 243 Const cstThisSub = &quot;CommandBar.Reset&quot;
 244         Utils._SetCalledSub(cstThisSub)
 245
 246         _Toolbar.reload()
 247
 248 Exit_Function:
 249         Reset = True
 250         Utils._ResetCalledSub(cstThisSub)
 251         Exit Function
 252 Error_Function:
 253         TraceError(TRACEABORT, Err, cstThisSub, Erl)
 254         Reset = False
 255         GoTo Exit_Function
 256 End Function    &apos;  Reset   V1.3.0
 257
 258 REM -----------------------------------------------------------------------------------------------------------------------
 259 REM --- PRIVATE FUNCTIONS                                                                                                                                                                                       ---
 260 REM -----------------------------------------------------------------------------------------------------------------------
 261
 262 REM -----------------------------------------------------------------------------------------------------------------------
 263 Private Function _FindElement(pvElements As Variant) As Integer
 264 &apos;  Return -1 if not found, otherwise return index in elements table of LayoutManager
 265
 266 Dim i As Integer
 267
 268         _FindElement = -1
 269         If Not IsArray(pvElements) Then Exit Function
 270
 271         For i = 0 To UBound(pvElements)
 272                 If _ResourceURL = pvElements(i).ResourceURL Then
 273                         _FindElement = i
 274                         Exit Function
 275                 End If
 276         Next i
 277
 278 End Function
 279
 280 REM -----------------------------------------------------------------------------------------------------------------------
 281 Private Function _PropertiesList() As Variant
 282          _PropertiesList = Array(&quot;BuiltIn&quot;, &quot;Name&quot;, &quot;ObjectType&quot;, &quot;Visible&quot;)
 283 End Function    &apos;  _PropertiesList
 284
 285 REM -----------------------------------------------------------------------------------------------------------------------
 286 Private Function _PropertyGet(ByVal psProperty As String) As Variant
 287 &apos;  Return property value of the psProperty property name
 288
 289         If _ErrorHandler() Then On Local Error Goto Error_Function
 290 Dim cstThisSub As String
 291         cstThisSub = &quot;CommandBar.get&quot; &amp; psProperty
 292         Utils._SetCalledSub(cstThisSub)
 293         _PropertyGet = Nothing
 294
 295 Dim oLayout As Object, iElementIndex As Integer
 296
 297         Select Case UCase(psProperty)
 298                 Case UCase(&quot;BuiltIn&quot;)
 299                         _PropertyGet = ( _BarBuiltin = 1 )
 300                 Case UCase(&quot;Name&quot;)
 301                         _PropertyGet = _Name
 302                 Case UCase(&quot;ObjectType&quot;)
 303                         _PropertyGet = _Type
 304                 Case UCase(&quot;Visible&quot;)
 305                         Set oLayout = _Window.LayoutManager
 306                         iElementIndex = _FindElement(oLayout.getElements())
 307                         If iElementIndex &lt; 0 Then _PropertyGet = False Else _PropertyGet = oLayout.isElementVisible(_ResourceURL)
 308                 Case Else
 309                         Goto Trace_Error
 310         End Select
 311
 312 Exit_Function:
 313         Utils._ResetCalledSub(cstThisSub)
 314         Exit Function
 315 Trace_Error:
 316         TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty)
 317         _PropertyGet = Nothing
 318         Goto Exit_Function
 319 Error_Function:
 320         TraceError(TRACEABORT, Err, Utils._CalledSub(), Erl)
 321         _PropertyGet = Nothing
 322         GoTo Exit_Function
 323 End Function            &apos;  _PropertyGet
 324
 325 REM -----------------------------------------------------------------------------------------------------------------------
 326 Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Variant) As Boolean
 327 &apos;  Return True if property setting OK
 328
 329         If _ErrorHandler() Then On Local Error Goto Error_Function
 330 Dim cstThisSub As String
 331         cstThisSub = &quot;CommandBar.set&quot; &amp; psProperty
 332         Utils._SetCalledSub(cstThisSub)
 333         _PropertySet = True
 334 Dim iArgNr As Integer
 335 Dim oLayout As Object, iElementIndex As Integer
 336
 337
 338         Select Case UCase(_A2B_.CalledSub)
 339                 Case UCase(&quot;setProperty&quot;)                             :       iArgNr = 3
 340                 Case UCase(&quot;CommandBar.setProperty&quot;)  :       iArgNr = 2
 341                 Case UCase(cstThisSub)                                  :       iArgNr = 1
 342         End Select
 343
 344         If Not hasProperty(psProperty) Then Goto Trace_Error
 345
 346         Select Case UCase(psProperty)
 347                 Case UCase(&quot;Visible&quot;)
 348                         If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value
 349                         Set oLayout = _Window.LayoutManager
 350                         With oLayout
 351                                 iElementIndex = _FindElement(.getElements())
 352                                 If iElementIndex &lt; 0 Then
 353                                         If pvValue Then
 354                                                 .createElement(_ResourceURL)
 355                                                 .showElement(_ResourceURL)
 356                                         End If
 357                                 Else
 358                                         If pvValue &lt;&gt; .isElementVisible(_ResourceURL) Then
 359                                                 If pvValue Then .showElement(_ResourceURL) Else .hideElement(_ResourceURL)
 360                                         End If
 361                                 End If
 362                         End With
 363                 Case Else
 364                         Goto Trace_Error
 365         End Select
 366
 367 Exit_Function:
 368         Utils._ResetCalledSub(cstThisSub)
 369         Exit Function
 370 Trace_Error:
 371         TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, , psProperty)
 372         _PropertySet = False
 373         Goto Exit_Function
 374 Trace_Error_Value:
 375         TraceError(TRACEFATAL, ERRPROPERTYVALUE, Utils._CalledSub(), 0, 1, Array(pvValue, psProperty))
 376         _PropertySet = False
 377         Goto Exit_Function
 378 Error_Function:
 379         TraceError(TRACEABORT, Err, cstThisSub, Erl)
 380         _PropertySet = False
 381         GoTo Exit_Function
 382 End Function                    &apos;  _PropertySet
 383 </script:module>