wizards/source/access2base/OptionGroup.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="OptionGroup" 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 FORM
  18 Private _Name                                   As String
  19 Private _ParentType                             As String
  20 Private _ParentComponent                As Object
  21 Private _MainForm                               As String
  22 Private _DocEntry                               As Integer
  23 Private _DbEntry                                As Integer
  24 Private _ButtonsGroup()                 As Variant
  25 Private _ButtonsIndex()                 As Variant
  26 Private _Count                                  As Long
  27
  28 REM -----------------------------------------------------------------------------------------------------------------------
  29 REM --- CONSTRUCTORS / DESTRUCTORS                                                                                                                                                                      ---
  30 REM -----------------------------------------------------------------------------------------------------------------------
  31 Private Sub Class_Initialize()
  32         _Type = OBJOPTIONGROUP
  33         _Name = &quot;&quot;
  34         _ParentType = &quot;&quot;
  35         _ParentComponent = Nothing
  36         _DocEntry = -1
  37         _DbEntry = -1
  38         _ButtonsGroup = Array()
  39         _ButtonsIndex = Array()
  40         _Count = 0
  41 End Sub         &apos;  Constructor
  42
  43 REM -----------------------------------------------------------------------------------------------------------------------
  44 Private Sub Class_Terminate()
  45         On Local Error Resume Next
  46         Call Class_Initialize()
  47 End Sub         &apos;  Destructor
  48
  49 REM -----------------------------------------------------------------------------------------------------------------------
  50 Public Sub Dispose()
  51         Call Class_Terminate()
  52 End Sub         &apos;  Explicit destructor
  53
  54 REM -----------------------------------------------------------------------------------------------------------------------
  55 REM --- CLASS GET/LET/SET PROPERTIES                                                                                                                                                            ---
  56 REM -----------------------------------------------------------------------------------------------------------------------
  57 Property Get Count() As Variant
  58         Count = _PropertyGet(&quot;Count&quot;)
  59 End Property    &apos;  Count (get)
  60
  61 REM -----------------------------------------------------------------------------------------------------------------------
  62 Property Get Name() As String
  63         Name = _PropertyGet(&quot;Name&quot;)
  64 End Property    &apos;  Name (get)
  65
  66 Public Function pName() As String               &apos;  For compatibility with &lt; V0.9.0
  67         pName = _PropertyGet(&quot;Name&quot;)
  68 End Function    &apos;  pName (get)
  69
  70 REM -----------------------------------------------------------------------------------------------------------------------
  71 Property Get ObjectType() As String
  72         ObjectType = _PropertyGet(&quot;ObjectType&quot;)
  73 End Property            &apos;  ObjectType (get)
  74
  75 REM -----------------------------------------------------------------------------------------------------------------------
  76 Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
  77 &apos;  Return
  78 &apos;          a Collection object if pvIndex absent
  79 &apos;          a Property object otherwise
  80
  81 Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String
  82         vPropertiesList = _PropertiesList()
  83         sObject = Utils._PCase(_Type)
  84         If IsMissing(pvIndex) Then
  85                 vProperty = PropertiesGet._Properties(sObject, _Name, vPropertiesList)
  86         Else
  87                 vProperty = PropertiesGet._Properties(sObject, _Name, vPropertiesList, pvIndex)
  88                 vProperty._Value = _PropertyGet(vPropertiesList(pvIndex))
  89         End If
  90
  91 Exit_Function:
  92         Set Properties = vProperty
  93         Exit Function
  94 End Function    &apos;  Properties
  95
  96 REM -----------------------------------------------------------------------------------------------------------------------
  97 Property Get Value() As Variant
  98         Value = _PropertyGet(&quot;Value&quot;)
  99 End Property    &apos;  Value (get)
 100
 101 Property Let Value(ByVal pvValue As Variant)
 102         Call _PropertySet(&quot;Value&quot;, pvValue)
 103 End Property    &apos;  Value (set)
 104
 105 REM -----------------------------------------------------------------------------------------------------------------------
 106 REM --- CLASS METHODS                                                                                                                                                                                           ---
 107 REM -----------------------------------------------------------------------------------------------------------------------
 108 Public Function Controls(Optional ByVal pvIndex As Variant) As Variant
 109 &apos;  Return a Control object with name or index = pvIndex
 110
 111 If _ErrorHandler() Then On Local Error Goto Error_Function
 112         Utils._SetCalledSub(&quot;OptionGroup.Controls&quot;)
 113
 114 Dim ocControl As Variant, iArgNr As Integer, i As Integer
 115
 116         Set ocControl = Nothing
 117
 118         If IsMissing(pvIndex) Then                                      &apos;  No argument, return Collection object
 119                 Set oCounter = New Collect
 120                 oCounter._SubType = OBJCONTROL
 121                 oCounter._ParentType = OBJOPTIONGROUP
 122                 oCounter._ParentName = _Name
 123                 oCounter._Count = _Count
 124                 Set Controls = oCounter
 125                 Goto Exit_Function
 126         End If
 127
 128         If _IsLeft(_A2B_.CalledSub, &quot;OptionGroup.&quot;) Then iArgNr = 1 Else iArgNr = 2
 129         If Not Utils._CheckArgument(pvIndex, iArgNr, Utils._AddNumeric()) Then Goto Exit_Function
 130         If pvIndex &lt; 0 Or pvIndex &gt; _Count - 1 Then Goto Trace_Error_Index
 131
 132         &apos;  Start building the ocControl object
 133         &apos;  Determine exact name
 134         Set ocControl = New Control
 135         ocControl._ParentType = CTLPARENTISGROUP
 136
 137         ocControl._Shortcut = &quot;&quot;
 138         For i = 0 To _Count - 1
 139                 If _ButtonsIndex(i) = pvIndex Then
 140                         Set ocControl.ControlModel = _ButtonsGroup(i)
 141                         Select Case _ParentType
 142                                 Case CTLPARENTISDIALOG          :       ocControl._Name = _ButtonsGroup(i).Name
 143                                 Case Else                                       :       ocControl._Name = _Name                 &apos;  OptionGroup and individual radio buttons share the same name
 144                         End Select
 145                         ocControl._ImplementationName = ocControl.ControlModel.getImplementationName()
 146                         Exit For
 147                 End If
 148         Next i
 149         ocControl._FormComponent = _ParentComponent
 150         ocControl._ClassId = acRadioButton
 151         Select Case _ParentType
 152                 Case CTLPARENTISDIALOG          :       Set ocControl.ControlView = _ParentComponent.getControl(ocControl._Name)
 153                 Case Else                                       :       Set ocControl.ControlView = _ParentComponent.CurrentController.getControl(ocControl.ControlModel)
 154         End Select
 155
 156         ocControl._Initialize()
 157         ocControl._DocEntry = _DocEntry
 158         ocControl._DbEntry = _DbEntry
 159         Set Controls = ocControl
 160
 161 Exit_Function:
 162         Utils._ResetCalledSub(&quot;OptionGroup.Controls&quot;)
 163         Exit Function
 164 Trace_Error_Index:
 165         TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0, 1)
 166         Set Controls = Nothing
 167         Goto Exit_Function
 168 Error_Function:
 169         TraceError(TRACEABORT, Err, &quot;OptionGroup.Controls&quot;, Erl)
 170         Set Controls = Nothing
 171         GoTo Exit_Function
 172 End Function            &apos;  Controls
 173
 174 REM -----------------------------------------------------------------------------------------------------------------------
 175 Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
 176 &apos;  Return property value of psProperty property name
 177
 178         Utils._SetCalledSub(&quot;OptionGroup.getProperty&quot;)
 179         If IsMissing(pvProperty) Then Call _TraceArguments()
 180         getProperty = _PropertyGet(pvProperty)
 181         Utils._ResetCalledSub(&quot;OptionGroup.getProperty&quot;)
 182
 183 End Function            &apos;  getProperty
 184
 185 REM -----------------------------------------------------------------------------------------------------------------------
 186 Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
 187 &apos;  Return True if object has a valid property called pvProperty (case-insensitive comparison !)
 188
 189         If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty)
 190         Exit Function
 191
 192 End Function    &apos;  hasProperty
 193
 194 REM -----------------------------------------------------------------------------------------------------------------------
 195 Public Function setProperty(ByVal Optional psProperty As String, ByVal Optional pvValue As Variant) As Boolean
 196 &apos;  Return True if property setting OK
 197         Utils._SetCalledSub(&quot;OptionGroup.setProperty&quot;)
 198         setProperty = _PropertySet(psProperty, pvValue)
 199         Utils._ResetCalledSub(&quot;OptionGroup.setProperty&quot;)
 200 End Function
 201
 202 REM -----------------------------------------------------------------------------------------------------------------------
 203 REM --- PRIVATE FUNCTIONS                                                                                                                                                                                       ---
 204 REM -----------------------------------------------------------------------------------------------------------------------
 205 REM -----------------------------------------------------------------------------------------------------------------------
 206 Private Function _PropertiesList() As Variant
 207
 208         _PropertiesList =  Array(&quot;Count&quot;, &quot;Name&quot;, &quot;ObjectType&quot;, &quot;Value&quot;)
 209
 210 End Function    &apos;  _PropertiesList
 211
 212 REM -----------------------------------------------------------------------------------------------------------------------
 213 Private Function _PropertyGet(ByVal psProperty As String) As Variant
 214 &apos;  Return property value of the psProperty property name
 215
 216         If _ErrorHandler() Then On Local Error Goto Error_Function
 217         Utils._SetCalledSub(&quot;OptionGroup.get&quot; &amp; psProperty)
 218
 219 &apos;Execute
 220 Dim oDatabase As Object, vBookmark As Variant
 221 Dim iValue As Integer, i As Integer
 222         _PropertyGet = EMPTY
 223         Select Case UCase(psProperty)
 224                 Case UCase(&quot;Count&quot;)
 225                         _PropertyGet = _Count
 226                 Case UCase(&quot;Name&quot;)
 227                         _PropertyGet = _Name
 228                 Case UCase(&quot;ObjectType&quot;)
 229                         _PropertyGet = _Type
 230                 Case UCase(&quot;Value&quot;)
 231                         iValue = -1
 232                         For i = 0 To _Count - 1                 &apos;  Find the selected RadioButton
 233                                 If _ButtonsGroup(i).State = 1 Then
 234                                         iValue = _ButtonsIndex(i)
 235                                         Exit For
 236                                 End If
 237                         Next i
 238                         _PropertyGet = iValue
 239                 Case Else
 240                         Goto Trace_Error
 241         End Select
 242
 243 Exit_Function:
 244         Utils._ResetCalledSub(&quot;OptionGroup.get&quot; &amp; psProperty)
 245         Exit Function
 246 Trace_Error:
 247         TraceError(TRACEWARNING, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty)
 248         _PropertyGet = EMPTY
 249         Goto Exit_Function
 250 Trace_Error_Index:
 251         TraceError(TRACEFATAL, ERRINDEXVALUE, Utils._CalledSub(), 0, 1, psProperty)
 252         _PropertyGet = EMPTY
 253         Goto Exit_Function
 254 Error_Function:
 255         TraceError(TRACEABORT, Err, &quot;OptionGroup._PropertyGet&quot;, Erl)
 256         _PropertyGet = EMPTY
 257         GoTo Exit_Function
 258 End Function            &apos;  _PropertyGet
 259
 260 REM -----------------------------------------------------------------------------------------------------------------------
 261 Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Variant) As Boolean
 262
 263         Utils._SetCalledSub(&quot;OptionGroup.set&quot; &amp; psProperty)
 264         If _ErrorHandler() Then On Local Error Goto Error_Function
 265         _PropertySet = True
 266
 267 &apos;Execute
 268 Dim i As Integer, iRadioIndex As Integer, oModel As Object, iArgNr As Integer
 269
 270         If _IsLeft(_A2B_.CalledSub, &quot;OptionGroup.&quot;) Then iArgNr = 1 Else iArgNr = 2
 271         Select Case UCase(psProperty)
 272                 Case UCase(&quot;Value&quot;)
 273                         If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
 274                         If pvValue &lt; 0 Or pvValue &gt; _Count - 1 Then Goto Trace_Error_Value
 275                         For i = 0 To _Count - 1
 276                                 _ButtonsGroup(i).State = 0
 277                                 If _ButtonsIndex(i) = pvValue Then iRadioIndex = i
 278                         Next i
 279                         _ButtonsGroup(iRadioIndex).State = 1
 280                         Set oModel = _ButtonsGroup(iRadioIndex)
 281                         If Utils._hasUNOProperty(oModel, &quot;DataField&quot;) Then
 282                                 If Not IsNull(oModel.Datafield) And Not IsEmpty(oModel.Datafield) Then
 283                                         If oModel.Datafield &lt;&gt; &quot;&quot; And Utils._hasUNOMethod(oModel, &quot;commit&quot;) Then oModel.commit()      &apos;  f.i. checkboxes have no commit method ?? [PASTIM]
 284                                 End If
 285                         End If
 286                 Case Else
 287                         Goto Trace_Error
 288         End Select
 289
 290 Exit_Function:
 291         Utils._ResetCalledSub(&quot;OptionGroup.set&quot; &amp; psProperty)
 292         Exit Function
 293 Trace_Error:
 294         TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty)
 295         _PropertySet = False
 296         Goto Exit_Function
 297 Trace_Error_Value:
 298         TraceError(TRACEFATAL, ERRPROPERTYVALUE, Utils._CalledSub(), 0, 1, Array(pvValue, psProperty))
 299         _PropertySet = False
 300         Goto Exit_Function
 301 Error_Function:
 302         TraceError(TRACEABORT, Err, &quot;OptionGroup._PropertySet&quot;, Erl)
 303         _PropertySet = False
 304         GoTo Exit_Function
 305 End Function            &apos;  _PropertySet
 306
 307 </script:module>