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