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