wizards/source/access2base/CommandBarControl.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="CommandBarControl" 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 COMMANDBARCONTROL
  18 Private _InternalIndex                  As Integer              &apos;  Index in toolbar including separators
  19 Private _Index                                  As Integer              &apos;  Index in collection, starting at 1 !!
  20 Private _ControlType                    As Integer              &apos;  1 of the msoControl* constants
  21 Private _ParentCommandBarName   As String
  22 Private _ParentCommandBar               As Object               &apos;  com.sun.star.ui.XUIElement
  23 Private _ParentBuiltin                  As Boolean
  24 Private _Element                                As Variant
  25 Private _BeginGroup                             As Boolean
  26
  27 REM -----------------------------------------------------------------------------------------------------------------------
  28 REM --- CONSTRUCTORS / DESTRUCTORS                                                                                                                                                                      ---
  29 REM -----------------------------------------------------------------------------------------------------------------------
  30 Private Sub Class_Initialize()
  31         _Type = OBJCOMMANDBARCONTROL
  32         _Index = -1
  33         _ParentCommandBarName = &quot;&quot;
  34         Set _ParentCommandBar = Nothing
  35         _ParentBuiltin = False
  36         _Element = Array()
  37         _BeginGroup = False
  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 BeginGroup() As Boolean
  57         BeginGroup = _PropertyGet(&quot;BeginGroup&quot;)
  58 End Property            &apos;  BeginGroup (get)
  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 Caption() As Variant
  67         Caption = _PropertyGet(&quot;Caption&quot;)
  68 End Property            &apos;  Caption (get)
  69
  70 Property Let Caption(ByVal pvValue As Variant)
  71         Call _PropertySet(&quot;Caption&quot;, pvValue)
  72 End Property            &apos;  Caption (set)
  73
  74 REM -----------------------------------------------------------------------------------------------------------------------
  75 Property Get Index() As Integer
  76         Index = _PropertyGet(&quot;Index&quot;)
  77 End Property            &apos;  Index (get)
  78
  79 REM -----------------------------------------------------------------------------------------------------------------------
  80 Property Get ObjectType() As String
  81         ObjectType = _PropertyGet(&quot;ObjectType&quot;)
  82 End Property            &apos;  ObjectType (get)
  83
  84 REM -----------------------------------------------------------------------------------------------------------------------
  85 Property Get OnAction() As Variant
  86         OnAction = _PropertyGet(&quot;OnAction&quot;)
  87 End Property            &apos;  OnAction (get)
  88
  89 Property Let OnAction(ByVal pvValue As Variant)
  90         Call _PropertySet(&quot;OnAction&quot;, pvValue)
  91 End Property            &apos;  OnAction (set)
  92
  93 REM -----------------------------------------------------------------------------------------------------------------------
  94 Property Get Parent() As Object
  95         Parent = _PropertyGet(&quot;Parent&quot;)
  96 End Property            &apos;  Parent (get)
  97
  98 REM -----------------------------------------------------------------------------------------------------------------------
  99 Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
 100 &apos;  Return
 101 &apos;          a Collection object if pvIndex absent
 102 &apos;          a Property object otherwise
 103
 104 Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String
 105         vPropertiesList = _PropertiesList()
 106         sObject = Utils._PCase(_Type)
 107         If IsMissing(pvIndex) Then
 108                 vProperty = PropertiesGet._Properties(sObject, _Name, vPropertiesList)
 109         Else
 110                 vProperty = PropertiesGet._Properties(sObject, _Name, vPropertiesList, pvIndex)
 111                 vProperty._Value = _PropertyGet(vPropertiesList(pvIndex))
 112         End If
 113
 114 Exit_Function:
 115         Set Properties = vProperty
 116         Exit Function
 117 End Function    &apos;  Properties
 118
 119 REM -----------------------------------------------------------------------------------------------------------------------
 120 Property Get TooltipText() As Variant
 121         TooltipText = _PropertyGet(&quot;TooltipText&quot;)
 122 End Property            &apos;  TooltipText (get)
 123
 124 Property Let TooltipText(ByVal pvValue As Variant)
 125         Call _PropertySet(&quot;TooltipText&quot;, pvValue)
 126 End Property            &apos;  TooltipText (set)
 127
 128 REM -----------------------------------------------------------------------------------------------------------------------
 129 Public Function pType() As Integer
 130         pType = _PropertyGet(&quot;Type&quot;)
 131 End Function            &apos;  Type (get)
 132
 133 REM -----------------------------------------------------------------------------------------------------------------------
 134 Property Get Visible() As Variant
 135         Visible = _PropertyGet(&quot;Visible&quot;)
 136 End Property            &apos;  Visible (get)
 137
 138 Property Let Visible(ByVal pvValue As Variant)
 139         Call _PropertySet(&quot;Visible&quot;, pvValue)
 140 End Property            &apos;  Visible (set)
 141
 142 REM -----------------------------------------------------------------------------------------------------------------------
 143 REM --- CLASS METHODS                                                                                                                                                                                           ---
 144 REM -----------------------------------------------------------------------------------------------------------------------
 145
 146 REM -----------------------------------------------------------------------------------------------------------------------
 147 Public Function Execute()
 148 &apos;  Execute the command stored in a toolbar button
 149
 150         If _ErrorHandler() Then On Local Error Goto Error_Function
 151 Const cstThisSub = &quot;CommandBarControl.Execute&quot;
 152         Utils._SetCalledSub(cstThisSub)
 153
 154 Dim sExecute As String
 155
 156         Execute = True
 157         sExecute = _GetPropertyValue(_Element, &quot;CommandURL&quot;, &quot;&quot;)
 158
 159         Select Case True
 160                 Case sExecute = &quot;&quot;            :       Execute = False
 161                 Case _IsLeft(sExecute, &quot;.uno:&quot;)
 162                         Execute = DoCmd.RunCommand(sExecute)
 163                 Case _IsLeft(sExecute, &quot;vnd.sun.star.script:&quot;)
 164                         Execute = Utils._RunScript(sExecute, Array(Nothing))
 165                 Case Else
 166         End Select
 167
 168 Exit_Function:
 169         Utils._ResetCalledSub(cstThisSub)
 170         Exit Function
 171 Error_Function:
 172         TraceError(TRACEABORT, Err, cstThisSub, Erl)
 173         Execute = False
 174         GoTo Exit_Function
 175 End Function    &apos;  Execute V1.3.0
 176
 177 REM -----------------------------------------------------------------------------------------------------------------------
 178 Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
 179 &apos;  Return property value of psProperty property name
 180
 181         Utils._SetCalledSub(&quot;CommandBarControl.getProperty&quot;)
 182         If IsMissing(pvProperty) Then Call _TraceArguments()
 183         getProperty = _PropertyGet(pvProperty)
 184         Utils._ResetCalledSub(&quot;CommandBar.getProperty&quot;)
 185
 186 End Function            &apos;  getProperty
 187
 188 REM -----------------------------------------------------------------------------------------------------------------------
 189 Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
 190 &apos;  Return True if object has a valid property called pvProperty (case-insensitive comparison !)
 191
 192         If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty)
 193         Exit Function
 194
 195 End Function    &apos;  hasProperty
 196
 197 REM -----------------------------------------------------------------------------------------------------------------------
 198 REM --- PRIVATE FUNCTIONS                                                                                                                                                                                       ---
 199 REM -----------------------------------------------------------------------------------------------------------------------
 200
 201 REM -----------------------------------------------------------------------------------------------------------------------
 202 Private Function _PropertiesList() As Variant
 203          _PropertiesList = Array(&quot;BeginGroup&quot;, &quot;BuiltIn&quot;, &quot;Caption&quot;, &quot;Index&quot; _
 204                                                                 , &quot;ObjectType&quot;, &quot;OnAction&quot;, &quot;Parent&quot; _
 205                                                                 , &quot;TooltipText&quot;, &quot;Type&quot;, &quot;Visible&quot; _
 206                                                                 )
 207 End Function    &apos;  _PropertiesList
 208
 209 REM -----------------------------------------------------------------------------------------------------------------------
 210 Private Function _PropertyGet(ByVal psProperty As String) As Variant
 211 &apos;  Return property value of the psProperty property name
 212
 213         If _ErrorHandler() Then On Local Error Goto Error_Function
 214 Dim cstThisSub As String
 215         cstThisSub = &quot;CommandBarControl.get&quot; &amp; psProperty
 216         Utils._SetCalledSub(cstThisSub)
 217         _PropertyGet = Null
 218
 219 Dim oLayout As Object, iElementIndex As Integer
 220 Dim sValue As String
 221 Const cstUnoPrefix = &quot;.uno:&quot;
 222
 223         Select Case UCase(psProperty)
 224                 Case UCase(&quot;BeginGroup&quot;)
 225                         _PropertyGet = _BeginGroup
 226                 Case UCase(&quot;BuiltIn&quot;)
 227                         sValue = _GetPropertyValue(_Element, &quot;CommandURL&quot;, &quot;&quot;)
 228                         _PropertyGet = ( _IsLeft(sValue, cstUnoPrefix) )
 229                 Case UCase(&quot;Caption&quot;)
 230                         _PropertyGet = _GetPropertyValue(_Element, &quot;Label&quot;, &quot;&quot;)
 231                 Case UCase(&quot;Index&quot;)
 232                         _PropertyGet = _Index
 233                 Case UCase(&quot;ObjectType&quot;)
 234                         _PropertyGet = _Type
 235                 Case UCase(&quot;OnAction&quot;)
 236                         _PropertyGet = _GetPropertyValue(_Element, &quot;CommandURL&quot;, &quot;&quot;)
 237                 Case UCase(&quot;Parent&quot;)
 238                         Set _PropertyGet = Application.CommandBars(_ParentCommandBarName)
 239                 Case UCase(&quot;TooltipText&quot;)
 240                                 sValue = _GetPropertyValue(_Element, &quot;Tooltip&quot;, &quot;&quot;)
 241                                 If sValue &lt;&gt; &quot;&quot; Then _PropertyGet = sValue Else _PropertyGet = _GetPropertyValue(_Element, &quot;Label&quot;, &quot;&quot;)
 242                 Case UCase(&quot;Type&quot;)
 243                                 _PropertyGet = msoControlButton
 244                 Case UCase(&quot;Visible&quot;)
 245                         _PropertyGet = _GetPropertyValue(_Element, &quot;IsVisible&quot;, &quot;&quot;)
 246                 Case Else
 247                         Goto Trace_Error
 248         End Select
 249
 250 Exit_Function:
 251         Utils._ResetCalledSub(cstThisSub)
 252         Exit Function
 253 Trace_Error:
 254         TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty)
 255         _PropertyGet = Nothing
 256         Goto Exit_Function
 257 Error_Function:
 258         TraceError(TRACEABORT, Err, Utils._CalledSub(), Erl)
 259         _PropertyGet = Nothing
 260         GoTo Exit_Function
 261 End Function            &apos;  _PropertyGet
 262
 263 REM -----------------------------------------------------------------------------------------------------------------------
 264 Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Variant) As Boolean
 265 &apos;  Return True if property setting OK
 266
 267         If _ErrorHandler() Then On Local Error Goto Error_Function
 268 Dim cstThisSub As String
 269         cstThisSub = &quot;CommandBarControl.set&quot; &amp; psProperty
 270         Utils._SetCalledSub(cstThisSub)
 271         _PropertySet = True
 272 Dim iArgNr As Integer
 273 Dim oSettings As Object, sValue As String
 274
 275
 276         Select Case UCase(_A2B_.CalledSub)
 277                 Case UCase(&quot;setProperty&quot;)                             :       iArgNr = 3
 278                 Case UCase(&quot;CommandBar.setProperty&quot;)  :       iArgNr = 2
 279                 Case UCase(cstThisSub)                                  :       iArgNr = 1
 280         End Select
 281
 282         If Not hasProperty(psProperty) Then Goto Trace_Error
 283         If _ParentBuiltin Then Goto Trace_Error         &apos;  Modifications of individual controls forbidden for builtin toolbars (design choice)
 284
 285 Const cstUnoPrefix = &quot;.uno:&quot;
 286 Const cstScript = &quot;vnd.sun.star.script:&quot;
 287
 288         Set oSettings = _ParentCommandBar.getSettings(True)
 289         Select Case UCase(psProperty)
 290                 Case UCase(&quot;OnAction&quot;)
 291                         If Not Utils._CheckArgument(pvValue, iArgNr, _AddNumeric(vbString), , False) Then Goto Trace_Error_Value
 292                         Select Case VarType(pvValue)
 293                                 Case vbString
 294                                         If _IsLeft(pvValue, cstUnoPrefix) Then
 295                                                 sValue = pvValue
 296                                         ElseIf _IsLeft(pvValue, cstScript) Then
 297                                                 sValue = pvValue
 298                                         Else
 299                                                 sValue = DoCmd.RunCommand(pvValue, True)
 300                                         End If
 301                                 Case Else                               &apos;  Numeric
 302                                         sValue = DoCmd.RunCommand(pvValue, True)
 303                         End Select
 304                         _SetPropertyValue(_Element, &quot;CommandURL&quot;, sValue)
 305                 Case UCase(&quot;TooltipText&quot;)
 306                         If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
 307                         _SetPropertyValue(_Element, &quot;Tooltip&quot;, pvValue)
 308                 Case UCase(&quot;Visible&quot;)
 309                         If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value
 310                         _SetPropertyValue(_Element, &quot;IsVisible&quot;, pvValue)
 311                 Case Else
 312                         Goto Trace_Error
 313         End Select
 314         oSettings.replaceByIndex(_InternalIndex, _Element)
 315         _ParentCommandBar.setSettings(oSettings)
 316
 317 Exit_Function:
 318         Utils._ResetCalledSub(cstThisSub)
 319         Exit Function
 320 Trace_Error:
 321         TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, , psProperty)
 322         _PropertySet = False
 323         Goto Exit_Function
 324 Trace_Error_Value:
 325         TraceError(TRACEFATAL, ERRPROPERTYVALUE, Utils._CalledSub(), 0, 1, Array(pvValue, psProperty))
 326         _PropertySet = False
 327         Goto Exit_Function
 328 Error_Function:
 329         TraceError(TRACEABORT, Err, cstThisSub, Erl)
 330         _PropertySet = False
 331         GoTo Exit_Function
 332 End Function                    &apos;  _PropertySet
 333 </script:module>