wizards/source/access2base/Methods.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="Methods" 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 Explicit
   9
  10 REM -----------------------------------------------------------------------------------------------------------------------
  11 Public Function AddItem(Optional pvBox As Variant, ByVal Optional pvItem As Variant, ByVal Optional pvIndex) As Boolean
  12 &apos;  Add an item in a Listbox
  13
  14         Utils._SetCalledSub(&quot;AddItem&quot;)
  15         If _ErrorHandler() Then On Local Error Goto Error_Function
  16
  17         If IsMissing(pvBox) Or IsMissing(pvItem) Then Call _TraceArguments()
  18         If IsMissing(pvIndex) Then pvIndex = -1
  19         If Not Utils._CheckArgument(pvBox, 1, Array(CTLLISTBOX, CTLCOMBOBOX)) Then Goto Exit_Function
  20
  21         AddItem = pvBox.AddItem(pvItem, pvIndex)
  22
  23 Exit_Function:
  24         Utils._ResetCalledSub(&quot;AddItem&quot;)
  25         Exit Function
  26 Error_Function:
  27         TraceError(TRACEABORT, Err, &quot;AddItem&quot;, Erl)
  28         AddItem = False
  29         GoTo Exit_Function
  30 End Function            &apos;  AddItem         V0.9.0
  31
  32 REM -----------------------------------------------------------------------------------------------------------------------
  33 Public Function hasProperty(Optional pvObject As Variant, ByVal Optional pvProperty As Variant) As Boolean
  34 &apos;  Return True if pvObject has a valid property called pvProperty (case-insensitive comparison !)
  35
  36 Dim vPropertiesList As Variant
  37
  38         Utils._SetCalledSub(&quot;hasProperty&quot;)
  39         If IsMissing(pvObject) Or IsMissing(pvProperty) Then Call _TraceArguments()
  40
  41         hasProperty = False
  42         If Not Utils._CheckArgument(pvObject, 1, Array(OBJCOLLECTION, OBJFORM, OBJSUBFORM, OBJCONTROL, OBJOPTIONGROUP, OBJEVENT _
  43                                                 , OBJPROPERTY, OBJDATABASE, OBJQUERYDEF, OBJTABLEDEF, OBJRECORDSET _
  44                                                 )) Then Goto Exit_Function
  45         If Not Utils._CheckArgument(pvProperty, 2, vbString) Then Goto Exit_Function
  46
  47         hasProperty = pvObject.hasProperty(pvProperty)
  48
  49 Exit_Function:
  50         Utils._ResetCalledSub(&quot;hasProperty&quot;)
  51         Exit Function
  52 End Function    &apos;  hasProperty             V0.9.0
  53
  54 REM -----------------------------------------------------------------------------------------------------------------------
  55 Public Function Move(Optional pvObject As Object _
  56                                                 , ByVal Optional pvLeft As Variant _
  57                                                 , ByVal Optional pvTop As Variant _
  58                                                 , ByVal Optional pvWidth As Variant _
  59                                                 , ByVal Optional pvHeight As Variant _
  60                                                 ) As Variant
  61 &apos;  Execute Move method
  62         Utils._SetCalledSub(&quot;Move&quot;)
  63         If IsMissing(pvObject) Then Call _TraceArguments()
  64         If _ErrorHandler() Then On Local Error Goto Error_Function
  65         Move = False
  66         If Not Utils._CheckArgument(pvObject,   1, Array(OBJFORM, OBJDIALOG)) Then Goto Exit_Function
  67         If IsMissing(pvLeft) Then Call _TraceArguments()
  68         If IsMissing(pvTop) Then pvTop = -1
  69         If IsMissing(pvWidth) Then pvWidth = -1
  70         If IsMissing(pvHeight) Then pvHeight = -1
  71
  72         Move = pvObject.Move(pvLeft, pvTop, pvWidth, pvHeight)
  73
  74 Exit_Function:
  75         Utils._ResetCalledSub(&quot;Move&quot;)
  76         Exit Function
  77 Error_Function:
  78         TraceError(TRACEABORT, Err, &quot;Move&quot;, Erl)
  79         GoTo Exit_Function
  80 End Function            &apos;  Move    V.0.9.1
  81
  82 REM -----------------------------------------------------------------------------------------------------------------------
  83 Public Function OpenHelpFile()
  84 &apos;  Open the help file from the Help menu (IDE only)
  85 Const cstHelpFile = &quot;http://www.access2base.com/access2base.html&quot;
  86
  87         On Local Error Resume Next
  88         Call _ShellExecute(cstHelpFile)
  89
  90 End Function    &apos;  OpenHelpFile    V0.8.5
  91
  92 REM -----------------------------------------------------------------------------------------------------------------------
  93 Public Function Properties(Optional pvObject As Variant, ByVal Optional pvIndex As Variant) As Variant
  94 &apos;  Return
  95 &apos;          a Collection object if pvIndex absent
  96 &apos;          a Property object otherwise
  97
  98 Dim vProperties As Variant, oCounter As Variant, opProperty As Variant
  99 Dim vPropertiesList() As Variant
 100
 101         If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments()
 102         Utils._SetCalledSub(&quot;Properties&quot;)
 103
 104         Set vProperties = Nothing
 105         If Not Utils._CheckArgument(pvObject, 1, Array(OBJCOLLECTION, OBJFORM, OBJSUBFORM, OBJCONTROL, OBJOPTIONGROUP, OBJEVENT _
 106                                                 , OBJPROPERTY, OBJDATABASE, OBJQUERYDEF, OBJTABLEDEF, OBJRECORDSET _
 107                                                 )) Then Goto Exit_Function
 108
 109         If IsMissing(pvIndex) Then vProperties = pvObject.Properties Else vProperties = pvObject.Properties(pvIndex)
 110
 111 Exit_Function:
 112         Set Properties = vProperties
 113         Utils._ResetCalledSub(&quot;Properties&quot;)
 114         Exit Function
 115 End Function            &apos;  Properties      V0.9.0
 116
 117 REM -----------------------------------------------------------------------------------------------------------------------
 118 Public Function Refresh(Optional pvObject As Variant) As Boolean
 119 &apos;  Refresh data with its most recent value in the database in a form or subform
 120         Utils._SetCalledSub(&quot;Refresh&quot;)
 121         If IsMissing(pvObject) Then Call _TraceArguments()
 122         If _ErrorHandler() Then On Local Error Goto Error_Function
 123         Refresh = False
 124         If Not Utils._CheckArgument(pvObject, 1, Array(OBJFORM, OBJSUBFORM)) Then Goto Exit_Function
 125
 126         Refresh = pvObject.Refresh()
 127
 128 Exit_Function:
 129         Utils._ResetCalledSub(&quot;Refresh&quot;)
 130         Exit Function
 131 Error_Function:
 132         TraceError(TRACEABORT, Err, &quot;Refresh&quot;, Erl)
 133         GoTo Exit_Function
 134 End Function    &apos;  Refresh         V0.9.0
 135
 136 REM -----------------------------------------------------------------------------------------------------------------------
 137 Public Function RemoveItem(Optional pvBox As Variant,ByVal Optional pvIndex) As Boolean
 138 &apos;  Remove an item from a Listbox
 139 &apos;  Index may be a string value or an index-position
 140
 141         Utils._SetCalledSub(&quot;RemoveItem&quot;)
 142         If _ErrorHandler() Then On Local Error Goto Error_Function
 143
 144         If IsMissing(pvBox) Or IsMissing(pvIndex) Then Call _TraceArguments()
 145         If Not Utils._CheckArgument(pvBox, 1, Array(CTLLISTBOX, CTLCOMBOBOX)) Then Goto Exit_Function
 146
 147         RemoveItem = pvBox.RemoveItem(pvIndex)
 148
 149 Exit_Function:
 150         Utils._ResetCalledSub(&quot;RemoveItem&quot;)
 151         Exit Function
 152 Error_Function:
 153         TraceError(TRACEABORT, Err, &quot;RemoveItem&quot;, Erl)
 154         RemoveItem = False
 155         GoTo Exit_Function
 156 End Function            &apos;  RemoveItem              V0.9.0
 157
 158 REM -----------------------------------------------------------------------------------------------------------------------
 159 Public Function Requery(Optional pvObject As Variant) As Boolean
 160 &apos;  Refresh data displayed in a form, subform, combobox or listbox
 161         Utils._SetCalledSub(&quot;Requery&quot;)
 162         If IsMissing(pvObject) Then Call _TraceArguments()
 163         If _ErrorHandler() Then On Local Error Goto Error_Function
 164         If Not Utils._CheckArgument(pvObject, 1, Array(OBJFORM, OBJCONTROL, OBJSUBFORM)) Then Goto Exit_Function
 165
 166         Requery = pvObject.Requery()
 167
 168 Exit_Function:
 169         Utils._ResetCalledSub(&quot;Requery&quot;)
 170         Exit Function
 171 Error_Function:
 172         TraceError(TRACEABORT, Err, &quot;Requery&quot;, Erl)
 173         GoTo Exit_Function
 174 End Function    &apos;  Requery         V0.9.0
 175
 176 REM -----------------------------------------------------------------------------------------------------------------------
 177 Public Function SetFocus(Optional pvObject As Variant) As Boolean
 178 &apos;  Execute SetFocus method
 179         Utils._SetCalledSub(&quot;setFocus&quot;)
 180         If IsMissing(pvObject) Then Call _TraceArguments()
 181         If _ErrorHandler() Then On Local Error Goto Error_Function
 182         If Not Utils._CheckArgument(pvObject, 1, Array(OBJFORM, OBJCONTROL)) Then Goto Exit_Function
 183
 184         SetFocus = pvObject.setFocus()
 185
 186 Exit_Function:
 187         Utils._ResetCalledSub(&quot;SetFocus&quot;)
 188         Exit Function
 189 Error_Function:
 190         TraceError(TRACEABORT, Err, &quot;SetFocus&quot;, Erl)
 191         Goto Exit_Function
 192 Error_Grid:
 193         TraceError(TRACEFATAL, ERRFOCUSINGRID, Utils._CalledSub(), 0, 1, Array(pvObject._Name, ocGrid._Name))
 194         Goto Exit_Function
 195 End Function    &apos;  SetFocus        V0.9.0
 196
 197 REM -----------------------------------------------------------------------------------------------------------------------
 198 REM --- PRIVATE FUNCTIONS                                                                                                                                                                                       ---
 199 REM -----------------------------------------------------------------------------------------------------------------------
 200 Public Function _OptionGroup(ByVal pvGroupName As Variant _
 201                                         , ByVal psParentType As String _
 202                                         , poComponent As Object _
 203                                         , poDatabaseForm As Object _
 204                                         ) As Variant
 205 &apos;  Return either an error or an object of type OPTIONGROUP based on its name
 206
 207         If IsMissing(pvGroupName) Then Call _TraceArguments()
 208         If _ErrorHandler() Then On Local Error Goto Error_Function
 209         Set _OptionGroup = Nothing
 210
 211         If Not Utils._CheckArgument(pvGroupName, 1, vbString) Then Goto Exit_Function
 212
 213 Dim ogGroup As Variant, i As Integer, j As Integer, bFound As Boolean
 214 Dim vOptionButtons() As Variant, sGroupName As String
 215 Dim lXY() As Long, iIndex() As Integer          &apos;  Two indexes X-Y coordinates
 216 Dim oView As Object
 217
 218 Const cstPixels = 10                                                    &apos;  Tolerance on coordinates when drawed approximately
 219         bFound = False
 220         For i = 0 To poDatabaseForm.GroupCount - 1              &apos;  Does a group with the right name exist ?
 221                 poDatabaseForm.getGroup(i, vOptionButtons, sGroupName)
 222                 If UCase(sGroupName) = UCase(Utils._Trim(pvGroupName)) Then
 223                         bFound = True
 224                         Exit For
 225                 End If
 226         Next i
 227
 228         If bFound Then
 229                 ogGroup = New Optiongroup
 230                 ogGroup._Name = sGroupName
 231                 ogGroup._ButtonsGroup = vOptionButtons
 232                 ogGroup._Count = UBound(vOptionButtons) + 1
 233                 ogGroup._ParentType = psParentType
 234                 Set ogGroup._ParentComponent = poComponent
 235
 236                 ReDim lXY(1, ogGroup._Count - 1)
 237                 ReDim iIndex(ogGroup._Count - 1)
 238                 For i = 0 To ogGroup._Count - 1                 &apos;  Find the position of each radiobutton
 239                         Set oView = poComponent.CurrentController.getControl(ogGroup._ButtonsGroup(i))
 240                         lXY(0, i) = oView.PosSize.X
 241                         lXY(1, i) = oView.PosSize.Y
 242                 Next i
 243                 For i = 0 To ogGroup._Count - 1                 &apos;  Sort them on XY coordinates
 244                         If i = 0 Then
 245                                 iIndex(0) = 0
 246                         Else
 247                                 iIndex(i) = i
 248                                 For j = i - 1 To 0 Step -1
 249                                         If lXY(1, i) - lXY(1, j) &lt; - cstPixels Or ( Abs(lXY(1, i) - lXY(1, j)) &lt;= cstPixels And lXY(0, i) - lXY(0, j) &lt; - cstPixels ) Then
 250                                                 iIndex(i) = iIndex(j)
 251                                                 iIndex(j) = iIndex(j) + 1
 252                                         End If
 253                                 Next j
 254                         End If
 255                 Next i
 256                 ogGroup._ButtonsIndex = iIndex()
 257
 258                 Set _OptionGroup = ogGroup
 259
 260         Else
 261
 262                 Set _OptionGroup = Nothing
 263                 TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, , Array(1, pvGroupName))
 264
 265         End If
 266
 267 Exit_Function:
 268         Exit Function
 269 Error_Function:
 270         TraceError(TRACEABORT, Err,&quot;_OptionGroup&quot;, Erl)
 271         GoTo Exit_Function
 272 End Function            &apos;  _OptionGroup    V1.1.0
 273 </script:module>