SubForm.xba 33 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757
  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="SubForm" 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. Option Compatible
  9. Option ClassModule
  10. Option Explicit
  11. REM -----------------------------------------------------------------------------------------------------------------------
  12. REM --- CLASS ROOT FIELDS ---
  13. REM -----------------------------------------------------------------------------------------------------------------------
  14. Private _Type As String &apos; Must be SUBFORM
  15. Private _This As Object &apos; Workaround for absence of This builtin function
  16. Private _Parent As Object
  17. Private _Shortcut As String
  18. Private _Name As String
  19. Private _MainForm As String
  20. Private _DocEntry As Integer
  21. Private _DbEntry As Integer
  22. Private _OrderBy As String
  23. Public ParentComponent As Object &apos; com.sun.star.text.TextDocument
  24. Public DatabaseForm As Object &apos; com.sun.star.form.component.DataForm and com.sun.star.sdb.ResultSet (a.o.)
  25. REM -----------------------------------------------------------------------------------------------------------------------
  26. REM --- CONSTRUCTORS / DESTRUCTORS ---
  27. REM -----------------------------------------------------------------------------------------------------------------------
  28. Private Sub Class_Initialize()
  29. _Type = OBJSUBFORM
  30. Set _This = Nothing
  31. Set _Parent = Nothing
  32. _Shortcut = &quot;&quot;
  33. _Name = &quot;&quot;
  34. _MainForm = &quot;&quot;
  35. _DocEntry = -1
  36. _DbEntry = -1
  37. _OrderBy = &quot;&quot;
  38. Set ParentComponent = Nothing
  39. Set DatabaseForm = Nothing
  40. End Sub &apos; Constructor
  41. REM -----------------------------------------------------------------------------------------------------------------------
  42. Private Sub Class_Terminate()
  43. On Local Error Resume Next
  44. Call Class_Initialize()
  45. End Sub &apos; Destructor
  46. REM -----------------------------------------------------------------------------------------------------------------------
  47. Public Sub Dispose()
  48. Call Class_Terminate()
  49. End Sub &apos; Explicit destructor
  50. REM -----------------------------------------------------------------------------------------------------------------------
  51. REM --- CLASS GET/LET/SET PROPERTIES ---
  52. REM -----------------------------------------------------------------------------------------------------------------------
  53. Property Get AllowAdditions() As Variant
  54. AllowAdditions = _PropertyGet(&quot;AllowAdditions&quot;)
  55. End Property &apos; AllowAdditions (get)
  56. Property Let AllowAdditions(ByVal pvValue As Variant)
  57. Call _PropertySet(&quot;AllowAdditions&quot;, pvValue)
  58. End Property &apos; AllowAdditions (set)
  59. REM -----------------------------------------------------------------------------------------------------------------------
  60. Property Get AllowDeletions() As Variant
  61. AllowDeletions = _PropertyGet(&quot;AllowDeletions&quot;)
  62. End Property &apos; AllowDeletions (get)
  63. Property Let AllowDeletions(ByVal pvValue As Variant)
  64. Call _PropertySet(&quot;AllowDeletions&quot;, pvValue)
  65. End Property &apos; AllowDeletions (set)
  66. REM -----------------------------------------------------------------------------------------------------------------------
  67. Property Get AllowEdits() As Variant
  68. AllowEdits = _PropertyGet(&quot;AllowEdits&quot;)
  69. End Property &apos; AllowEdits (get)
  70. Property Let AllowEdits(ByVal pvValue As Variant)
  71. Call _PropertySet(&quot;AllowEdits&quot;, pvValue)
  72. End Property &apos; AllowEdits (set)
  73. REM -----------------------------------------------------------------------------------------------------------------------
  74. Property Get CurrentRecord() As Variant
  75. CurrentRecord = _PropertyGet(&quot;CurrentRecord&quot;)
  76. End Property &apos; CurrentRecord (get)
  77. Property Let CurrentRecord(ByVal pvValue As Variant)
  78. Call _PropertySet(&quot;CurrentRecord&quot;, pvValue)
  79. End Property &apos; CurrentRecord (set)
  80. REM -----------------------------------------------------------------------------------------------------------------------
  81. Property Get Filter() As Variant
  82. Filter = _PropertyGet(&quot;Filter&quot;)
  83. End Property &apos; Filter (get)
  84. Property Let Filter(ByVal pvValue As Variant)
  85. Call _PropertySet(&quot;Filter&quot;, pvValue)
  86. End Property &apos; Filter (set)
  87. REM -----------------------------------------------------------------------------------------------------------------------
  88. Property Get FilterOn() As Variant
  89. FilterOn = _PropertyGet(&quot;FilterOn&quot;)
  90. End Property &apos; FilterOn (get)
  91. Property Let FilterOn(ByVal pvValue As Variant)
  92. Call _PropertySet(&quot;FilterOn&quot;, pvValue)
  93. End Property &apos; FilterOn (set)
  94. REM -----------------------------------------------------------------------------------------------------------------------
  95. Property Get LinkChildFields(ByVal Optional pvIndex As Variant) As Variant
  96. If IsMissing(pvIndex) Then LinkChildFields = _PropertyGet(&quot;LinkChildFields&quot;) Else LinkChildFields = _PropertyGet(&quot;LinkChildFields&quot;, pvIndex)
  97. End Property &apos; LinkChildFields (get)
  98. REM -----------------------------------------------------------------------------------------------------------------------
  99. Property Get LinkMasterFields(ByVal Optional pvIndex As Variant) As Variant
  100. If IsMissing(pvIndex) Then LinkMasterFields = _PropertyGet(&quot;LinkMasterFields&quot;) Else LinkMasterFields = _PropertyGet(&quot;LinkMasterFields&quot;, pvIndex)
  101. End Property &apos; LinkMasterFields (get)
  102. REM -----------------------------------------------------------------------------------------------------------------------
  103. Property Get Name() As String
  104. Name = _PropertyGet(&quot;Name&quot;)
  105. End Property &apos; Name (get)
  106. Public Function pName() As String &apos; For compatibility with &lt; V0.9.0
  107. pName = _PropertyGet(&quot;Name&quot;)
  108. End Function &apos; pName (get)
  109. REM -----------------------------------------------------------------------------------------------------------------------
  110. Property Get ObjectType() As String
  111. ObjectType = _PropertyGet(&quot;ObjectType&quot;)
  112. End Property &apos; ObjectType (get)
  113. REM -----------------------------------------------------------------------------------------------------------------------
  114. Property Get OnApproveCursorMove() As Variant
  115. OnApproveCursorMove = _PropertyGet(&quot;OnApproveCursorMove&quot;)
  116. End Property &apos; OnApproveCursorMove (get)
  117. Property Let OnApproveCursorMove(ByVal pvValue As Variant)
  118. Call _PropertySet(&quot;OnApproveCursorMove&quot;, pvValue)
  119. End Property &apos; OnApproveCursorMove (set)
  120. REM -----------------------------------------------------------------------------------------------------------------------
  121. Property Get OnApproveParameter() As Variant
  122. OnApproveParameter = _PropertyGet(&quot;OnApproveParameter&quot;)
  123. End Property &apos; OnApproveParameter (get)
  124. Property Let OnApproveParameter(ByVal pvValue As Variant)
  125. Call _PropertySet(&quot;OnApproveParameter&quot;, pvValue)
  126. End Property &apos; OnApproveParameter (set)
  127. REM -----------------------------------------------------------------------------------------------------------------------
  128. Property Get OnApproveReset() As Variant
  129. OnApproveReset = _PropertyGet(&quot;OnApproveReset&quot;)
  130. End Property &apos; OnApproveReset (get)
  131. Property Let OnApproveReset(ByVal pvValue As Variant)
  132. Call _PropertySet(&quot;OnApproveReset&quot;, pvValue)
  133. End Property &apos; OnApproveReset (set)
  134. REM -----------------------------------------------------------------------------------------------------------------------
  135. Property Get OnApproveRowChange() As Variant
  136. OnApproveRowChange = _PropertyGet(&quot;OnApproveRowChange&quot;)
  137. End Property &apos; OnApproveRowChange (get)
  138. Property Let OnApproveRowChange(ByVal pvValue As Variant)
  139. Call _PropertySet(&quot;OnApproveRowChange&quot;, pvValue)
  140. End Property &apos; OnApproveRowChange (set)
  141. REM -----------------------------------------------------------------------------------------------------------------------
  142. Property Get OnApproveSubmit() As Variant
  143. OnApproveSubmit = _PropertyGet(&quot;OnApproveSubmit&quot;)
  144. End Property &apos; OnApproveSubmit (get)
  145. Property Let OnApproveSubmit(ByVal pvValue As Variant)
  146. Call _PropertySet(&quot;OnApproveSubmit&quot;, pvValue)
  147. End Property &apos; OnApproveSubmit (set)
  148. REM -----------------------------------------------------------------------------------------------------------------------
  149. Property Get OnConfirmDelete() As Variant
  150. OnConfirmDelete = _PropertyGet(&quot;OnConfirmDelete&quot;)
  151. End Property &apos; OnConfirmDelete (get)
  152. Property Let OnConfirmDelete(ByVal pvValue As Variant)
  153. Call _PropertySet(&quot;OnConfirmDelete&quot;, pvValue)
  154. End Property &apos; OnConfirmDelete (set)
  155. REM -----------------------------------------------------------------------------------------------------------------------
  156. Property Get OnCursorMoved() As Variant
  157. OnCursorMoved = _PropertyGet(&quot;OnCursorMoved&quot;)
  158. End Property &apos; OnCursorMoved (get)
  159. Property Let OnCursorMoved(ByVal pvValue As Variant)
  160. Call _PropertySet(&quot;OnCursorMoved&quot;, pvValue)
  161. End Property &apos; OnCursorMoved (set)
  162. REM -----------------------------------------------------------------------------------------------------------------------
  163. Property Get OnErrorOccurred() As Variant
  164. OnErrorOccurred = _PropertyGet(&quot;OnErrorOccurred&quot;)
  165. End Property &apos; OnErrorOccurred (get)
  166. Property Let OnErrorOccurred(ByVal pvValue As Variant)
  167. Call _PropertySet(&quot;OnErrorOccurred&quot;, pvValue)
  168. End Property &apos; OnErrorOccurred (set)
  169. REM -----------------------------------------------------------------------------------------------------------------------
  170. Property Get OnLoaded() As Variant
  171. OnLoaded = _PropertyGet(&quot;OnLoaded&quot;)
  172. End Property &apos; OnLoaded (get)
  173. Property Let OnLoaded(ByVal pvValue As Variant)
  174. Call _PropertySet(&quot;OnLoaded&quot;, pvValue)
  175. End Property &apos; OnLoaded (set)
  176. REM -----------------------------------------------------------------------------------------------------------------------
  177. Property Get OnReloaded() As Variant
  178. OnReloaded = _PropertyGet(&quot;OnReloaded&quot;)
  179. End Property &apos; OnReloaded (get)
  180. Property Let OnReloaded(ByVal pvValue As Variant)
  181. Call _PropertySet(&quot;OnReloaded&quot;, pvValue)
  182. End Property &apos; OnReloaded (set)
  183. REM -----------------------------------------------------------------------------------------------------------------------
  184. Property Get OnReloading() As Variant
  185. OnReloading = _PropertyGet(&quot;OnReloading&quot;)
  186. End Property &apos; OnReloading (get)
  187. Property Let OnReloading(ByVal pvValue As Variant)
  188. Call _PropertySet(&quot;OnReloading&quot;, pvValue)
  189. End Property &apos; OnReloading (set)
  190. REM -----------------------------------------------------------------------------------------------------------------------
  191. Property Get OnResetted() As Variant
  192. OnResetted = _PropertyGet(&quot;OnResetted&quot;)
  193. End Property &apos; OnResetted (get)
  194. Property Let OnResetted(ByVal pvValue As Variant)
  195. Call _PropertySet(&quot;OnResetted&quot;, pvValue)
  196. End Property &apos; OnResetted (set)
  197. REM -----------------------------------------------------------------------------------------------------------------------
  198. Property Get OnRowChanged() As Variant
  199. OnRowChanged = _PropertyGet(&quot;OnRowChanged&quot;)
  200. End Property &apos; OnRowChanged (get)
  201. Property Let OnRowChanged(ByVal pvValue As Variant)
  202. Call _PropertySet(&quot;OnRowChanged&quot;, pvValue)
  203. End Property &apos; OnRowChanged (set)
  204. REM -----------------------------------------------------------------------------------------------------------------------
  205. Property Get OnUnloaded() As Variant
  206. OnUnloaded = _PropertyGet(&quot;OnUnloaded&quot;)
  207. End Property &apos; OnUnloaded (get)
  208. Property Let OnUnloaded(ByVal pvValue As Variant)
  209. Call _PropertySet(&quot;OnUnloaded&quot;, pvValue)
  210. End Property &apos; OnUnloaded (set)
  211. REM -----------------------------------------------------------------------------------------------------------------------
  212. Property Get OnUnloading() As Variant
  213. OnUnloading = _PropertyGet(&quot;OnUnloading&quot;)
  214. End Property &apos; OnUnloading (get)
  215. Property Let OnUnloading(ByVal pvValue As Variant)
  216. Call _PropertySet(&quot;OnUnloading&quot;, pvValue)
  217. End Property &apos; OnUnloading (set)
  218. REM -----------------------------------------------------------------------------------------------------------------------
  219. Public Function OptionGroup(ByVal Optional pvGroupName As Variant) As Variant
  220. &apos; Return either an error or an object of type OPTIONGROUP based on its name
  221. Const cstThisSub = &quot;SubForm.OptionGroup&quot;
  222. Dim ogGroup As Object
  223. Utils._SetCalledSub(cstThisSub)
  224. If IsMissing(pvGroupName) Then Call _TraceArguments()
  225. If _ErrorHandler() Then On Local Error Goto Error_Function
  226. Set ogGroup = _OptionGroup(pvGroupName, CTLPARENTISSUBFORM, ParentComponent, DatabaseForm)
  227. If Not IsNull(ogGroup) Then
  228. ogGroup._DocEntry = _DocEntry
  229. ogGroup._DbEntry = _DbEntry
  230. End If
  231. Set OptionGroup = ogGroup
  232. Exit_Function:
  233. Utils._ResetCalledSub(cstThisSub)
  234. Exit Function
  235. Error_Function:
  236. TraceError(TRACEABORT, Err, cstThisSub, Erl)
  237. GoTo Exit_Function
  238. End Function &apos; OptionGroup V1.1.0
  239. REM -----------------------------------------------------------------------------------------------------------------------
  240. Property Get OrderBy() As Variant
  241. OrderBy = _PropertyGet(&quot;OrderBy&quot;)
  242. End Property &apos; OrderBy (get) V1.2.0
  243. Property Let OrderBy(ByVal pvValue As Variant)
  244. Call _PropertySet(&quot;OrderBy&quot;, pvValue)
  245. End Property &apos; OrderBy (set)
  246. REM -----------------------------------------------------------------------------------------------------------------------
  247. Property Get OrderByOn() As Variant
  248. OrderByOn = _PropertyGet(&quot;OrderByOn&quot;)
  249. End Property &apos; OrderByOn (get) V1.2.0
  250. Property Let OrderByOn(ByVal pvValue As Variant)
  251. Call _PropertySet(&quot;OrderByOn&quot;, pvValue)
  252. End Property &apos; OrderByOn (set)
  253. REM -----------------------------------------------------------------------------------------------------------------------
  254. Public Function Parent() As Object
  255. Utils._SetCalledSub(&quot;SubForm.getParent&quot;)
  256. On Error Goto Error_Function
  257. Set Parent = _Parent
  258. Exit_Function:
  259. Utils._ResetCalledSub(&quot;SubForm.getParent&quot;)
  260. Exit Function
  261. Error_Function:
  262. TraceError(TRACEABORT, Err, &quot;SubForm.getParent&quot;, Erl)
  263. Set Parent = Nothing
  264. GoTo Exit_Function
  265. End Function &apos; Parent
  266. REM -----------------------------------------------------------------------------------------------------------------------
  267. Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
  268. &apos; Return
  269. &apos; a Collection object if pvIndex absent
  270. &apos; a Property object otherwise
  271. Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String
  272. vPropertiesList = _PropertiesList()
  273. sObject = Utils._PCase(_Type)
  274. If IsMissing(pvIndex) Then
  275. vProperty = PropertiesGet._Properties(sObject, _This, vPropertiesList)
  276. Else
  277. vProperty = PropertiesGet._Properties(sObject, _This, vPropertiesList, pvIndex)
  278. vProperty._Value = _PropertyGet(vPropertiesList(pvIndex))
  279. End If
  280. Exit_Function:
  281. Set Properties = vProperty
  282. Exit Function
  283. End Function &apos; Properties
  284. REM -----------------------------------------------------------------------------------------------------------------------
  285. Property Get Recordset() As Object
  286. Recordset = _PropertyGet(&quot;Recordset&quot;)
  287. End Property &apos; Recordset (get) V0.9.5
  288. REM -----------------------------------------------------------------------------------------------------------------------
  289. Property Get RecordSource() As Variant
  290. RecordSource = _PropertyGet(&quot;RecordSource&quot;)
  291. End Property &apos; RecordSource (get)
  292. Property Let RecordSource(ByVal pvValue As Variant)
  293. Call _PropertySet(&quot;RecordSource&quot;, pvValue)
  294. End Property &apos; RecordSource (set)
  295. REM -----------------------------------------------------------------------------------------------------------------------
  296. REM --- CLASS METHODS ---
  297. REM -----------------------------------------------------------------------------------------------------------------------
  298. Public Function Controls(Optional ByVal pvIndex As Variant) As Variant
  299. &apos; Return a Control object with name or index = pvIndex
  300. If _ErrorHandler() Then On Local Error Goto Error_Function
  301. Utils._SetCalledSub(&quot;SubForm.Controls&quot;)
  302. Dim ocControl As Variant, sParentShortcut As String, iControlCount As Integer
  303. Dim oCounter As Variant, sControls() As Variant, i As Integer, bFound As Boolean, sIndex As String
  304. Dim j As Integer
  305. Set ocControl = Nothing
  306. iControlCount = DatabaseForm.getCount()
  307. If IsMissing(pvIndex) Then &apos; No argument, return Collection pseudo-object
  308. Set oCounter = New Collect
  309. Set oCounter._This = oCounter
  310. oCounter._CollType = COLLCONTROLS
  311. oCounter._Parent = _This
  312. oCounter._Count = iControlCount
  313. Set Controls = oCounter
  314. Goto Exit_Function
  315. End If
  316. If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function
  317. &apos; Start building the ocControl object
  318. &apos; Determine exact name
  319. Set ocControl = New Control
  320. Set ocControl._This = ocControl
  321. Set ocControl._Parent = _This
  322. ocControl._ParentType = CTLPARENTISSUBFORM
  323. sParentShortcut = _Shortcut
  324. sControls() = DatabaseForm.getElementNames()
  325. Select Case VarType(pvIndex)
  326. Case vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbBigint, vbDecimal
  327. If pvIndex &lt; 0 Or pvIndex &gt; iControlCount - 1 Then Goto Trace_Error_Index
  328. ocControl._Name = sControls(pvIndex)
  329. Case vbString &apos; Check control name validity (non case sensitive)
  330. bFound = False
  331. sIndex = UCase(Utils._Trim(pvIndex))
  332. For i = 0 To iControlCount - 1
  333. If UCase(sControls(i)) = sIndex Then
  334. bFound = True
  335. Exit For
  336. End If
  337. Next i
  338. If bFound Then ocControl._Name = sControls(i) Else Goto Trace_NotFound
  339. End Select
  340. With ocControl
  341. ._Shortcut = sParentShortcut &amp; &quot;!&quot; &amp; Utils._Surround(._Name)
  342. Set .ControlModel = DatabaseForm.getByName(._Name)
  343. ._ImplementationName = .ControlModel.getImplementationName()
  344. ._FormComponent = ParentComponent
  345. If Utils._hasUNOProperty(.ControlModel, &quot;ClassId&quot;) Then ._ClassId = .ControlModel.ClassId
  346. If ._ClassId &gt; 0 And ._ClassId &lt;&gt; acHiddenControl Then
  347. Set .ControlView = ParentComponent.CurrentController.getControl(.ControlModel)
  348. End If
  349. ._Initialize()
  350. ._DocEntry = _DocEntry
  351. ._DbEntry = _DbEntry
  352. End With
  353. Set Controls = ocControl
  354. Exit_Function:
  355. Utils._ResetCalledSub(&quot;SubForm.Controls&quot;)
  356. Exit Function
  357. Trace_Error_Index:
  358. TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0, 1)
  359. Set Controls = Nothing
  360. Goto Exit_Function
  361. Trace_NotFound:
  362. TraceError(TRACEFATAL, ERRCONTROLNOTFOUND, Utils._CalledSub(), 0, , Array(pvIndex, _Name))
  363. Set Controls = Nothing
  364. Goto Exit_Function
  365. Error_Function:
  366. TraceError(TRACEABORT, Err, &quot;SubForm.Controls&quot;, Erl)
  367. Set Controls = Nothing
  368. GoTo Exit_Function
  369. End Function &apos; Controls V1.1.0
  370. REM -----------------------------------------------------------------------------------------------------------------------
  371. Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
  372. &apos; Return property value of psProperty property name
  373. Utils._SetCalledSub(&quot;SubForm.getProperty&quot;)
  374. If IsMissing(pvProperty) Then Call _TraceArguments()
  375. getProperty = _PropertyGet(pvProperty)
  376. Utils._ResetCalledSub(&quot;SubForm.getProperty&quot;)
  377. End Function &apos; getProperty
  378. REM -----------------------------------------------------------------------------------------------------------------------
  379. Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
  380. &apos; Return True if object has a valid property called pvProperty (case-insensitive comparison !)
  381. If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty)
  382. Exit Function
  383. End Function &apos; hasProperty
  384. REM -----------------------------------------------------------------------------------------------------------------------
  385. Public Function Refresh() As Boolean
  386. &apos; Refresh data with its most recent value in the database in a form or subform
  387. Utils._SetCalledSub(&quot;SubForm.Refresh&quot;)
  388. If _ErrorHandler() Then On Local Error Goto Error_Function
  389. Refresh = False
  390. Dim oSet As Object
  391. Set oSet = DatabaseForm.createResultSet()
  392. If Not IsNull(oSet) Then
  393. oSet.refreshRow()
  394. Refresh = True
  395. End If
  396. Exit_Function:
  397. Set oSet = Nothing
  398. Utils._ResetCalledSub(&quot;SubForm.Refresh&quot;)
  399. Exit Function
  400. Error_Function:
  401. TraceError(TRACEABORT, Err, &quot;SubForm.Refresh&quot;, Erl)
  402. GoTo Exit_Function
  403. End Function &apos; Refresh
  404. REM -----------------------------------------------------------------------------------------------------------------------
  405. Public Function Requery() As Boolean
  406. &apos; Refresh data displayed in a form, subform, combobox or listbox
  407. Utils._SetCalledSub(&quot;SubForm.Requery&quot;)
  408. If _ErrorHandler() Then On Local Error Goto Error_Function
  409. Requery = False
  410. DatabaseForm.reload()
  411. Requery = True
  412. Exit_Function:
  413. Utils._ResetCalledSub(&quot;SubForm.Requery&quot;)
  414. Exit Function
  415. Error_Function:
  416. TraceError(TRACEABORT, Err, &quot;SubForm.Requery&quot;, Erl)
  417. GoTo Exit_Function
  418. End Function &apos; Requery
  419. REM -----------------------------------------------------------------------------------------------------------------------
  420. Public Function setProperty(ByVal Optional psProperty As String, ByVal Optional pvValue As Variant) As Boolean
  421. &apos; Return True if property setting OK
  422. Utils._SetCalledSub(&quot;SubForm.setProperty&quot;)
  423. setProperty = _PropertySet(psProperty, pvValue)
  424. Utils._ResetCalledSub(&quot;SubForm.setProperty&quot;)
  425. End Function
  426. REM -----------------------------------------------------------------------------------------------------------------------
  427. REM --- PRIVATE FUNCTIONS ---
  428. REM -----------------------------------------------------------------------------------------------------------------------
  429. Private Function _GetListener(ByVal psProperty As String) As String
  430. &apos; Return the X...Listener corresponding with the property in argument
  431. Select Case UCase(psProperty)
  432. Case UCase(&quot;OnApproveCursorMove&quot;)
  433. _GetListener = &quot;XRowSetApproveListener&quot;
  434. Case UCase(&quot;OnApproveParameter&quot;)
  435. _GetListener = &quot;XDatabaseParameterListener&quot;
  436. Case UCase(&quot;OnApproveReset&quot;), UCase(&quot;OnResetted&quot;)
  437. _GetListener = &quot;XResetListener&quot;
  438. Case UCase(&quot;OnApproveRowChange&quot;)
  439. _GetListener = &quot;XRowSetApproveListener&quot;
  440. Case UCase(&quot;OnApproveSubmit&quot;)
  441. _GetListener = &quot;XSubmitListener&quot;
  442. Case UCase(&quot;OnConfirmDelete&quot;)
  443. _GetListener = &quot;XConfirmDeleteListener&quot;
  444. Case UCase(&quot;OnCursorMoved&quot;), UCase(&quot;OnRowChanged&quot;)
  445. _GetListener = &quot;XRowSetListener&quot;
  446. Case UCase(&quot;OnErrorOccurred&quot;)
  447. _GetListener = &quot;XSQLErrorListener&quot;
  448. Case UCase(&quot;OnLoaded&quot;), UCase(&quot;OnReloaded&quot;), UCase(&quot;OnReloading&quot;), UCase(&quot;OnUnloaded&quot;), UCase(&quot;OnUnloading&quot;)
  449. _GetListener = &quot;XLoadListener&quot;
  450. End Select
  451. End Function &apos; _GetListener V1.7.0
  452. REM -----------------------------------------------------------------------------------------------------------------------
  453. Private Function _PropertiesList() As Variant
  454. _PropertiesList = Array(&quot;AllowAdditions&quot;, &quot;AllowDeletions&quot;, &quot;AllowEdits&quot;, &quot;CurrentRecord&quot; _
  455. , &quot;Filter&quot;, &quot;FilterOn&quot;, &quot;LinkChildFields&quot;, &quot;LinkMasterFields&quot;, &quot;Name&quot; _
  456. , &quot;ObjectType&quot;, &quot;OnApproveCursorMove&quot;, &quot;OnApproveParameter&quot; _
  457. , &quot;OnApproveReset&quot;, &quot;OnApproveRowChange&quot;, &quot;OnApproveSubmit&quot;, &quot;OnConfirmDelete&quot; _
  458. , &quot;OnCursorMoved&quot;, &quot;OnErrorOccurred&quot;, &quot;OnLoaded&quot;, &quot;OnReloaded&quot;, &quot;OnReloading&quot; _
  459. , &quot;OnResetted&quot;, &quot;OnRowChanged&quot;, &quot;OnUnloaded&quot;, &quot;OnUnloading&quot;, &quot;OrderBy&quot; _
  460. , &quot;OrderByOn&quot;, &quot;Parent&quot;, &quot;RecordSource&quot; _
  461. ) &apos; Recordset removed
  462. End Function &apos; _PropertiesList
  463. REM -----------------------------------------------------------------------------------------------------------------------
  464. Private Function _PropertyGet(ByVal psProperty As String, ByVal Optional pvIndex As Variant) As Variant
  465. &apos; Return property value of the psProperty property name
  466. If _ErrorHandler() Then On Local Error Goto Error_Function
  467. Utils._SetCalledSub(&quot;SubForm.get&quot; &amp; psProperty)
  468. Dim iArgNr As Integer
  469. If Not IsMissing(pvIndex) Then
  470. Select Case UCase(_A2B_.CalledSub)
  471. Case UCase(&quot;getProperty&quot;) : iArgNr = 3
  472. Case UCase(&quot;SubForm.getProperty&quot;) : iArgNr = 2
  473. Case UCase(&quot;SubForm.get&quot; &amp; psProperty) : iArgNr = 1
  474. End Select
  475. If Not Utils._CheckArgument(pvIndex, iArgNr, Utils._AddNumeric()) Then Goto Exit_Function
  476. End If
  477. &apos;Execute
  478. Dim oDatabase As Object, vBookmark As Variant, oObject As Object
  479. _PropertyGet = EMPTY
  480. Select Case UCase(psProperty)
  481. Case UCase(&quot;AllowAdditions&quot;)
  482. _PropertyGet = DatabaseForm.AllowInserts
  483. Case UCase(&quot;AllowDeletions&quot;)
  484. _PropertyGet = DatabaseForm.AllowDeletes
  485. Case UCase(&quot;AllowEdits&quot;)
  486. _PropertyGet = DatabaseForm.AllowUpdates
  487. Case UCase(&quot;CurrentRecord&quot;)
  488. _PropertyGet = DatabaseForm.Row
  489. Case UCase(&quot;Filter&quot;)
  490. _PropertyGet = DatabaseForm.Filter
  491. Case UCase(&quot;FilterOn&quot;)
  492. _PropertyGet = DatabaseForm.ApplyFilter
  493. Case UCase(&quot;LinkChildFields&quot;)
  494. If Utils._hasUNOProperty(DatabaseForm, &quot;DetailFields&quot;) Then
  495. If IsMissing(pvIndex) Then
  496. _PropertyGet = DatabaseForm.DetailFields
  497. Else
  498. If pvIndex &lt; 0 Or pvIndex &gt; UBound(DatabaseForm.DetailFields) Then Goto trace_Error_Index
  499. _PropertyGet = DatabaseForm.DetailFields(pvIndex)
  500. End If
  501. End If
  502. Case UCase(&quot;LinkMasterFields&quot;)
  503. If Utils._hasUNOProperty(DatabaseForm, &quot;MasterFields&quot;) Then
  504. If IsMissing(pvIndex) Then
  505. _PropertyGet = DatabaseForm.MasterFields
  506. Else
  507. If pvIndex &lt; 0 Or pvIndex &gt; UBound(DatabaseForm.MasterFields) Then Goto trace_Error_Index
  508. _PropertyGet = DatabaseForm.MasterFields(pvIndex)
  509. End If
  510. End If
  511. Case UCase(&quot;Name&quot;)
  512. _PropertyGet = _Name
  513. Case UCase(&quot;ObjectType&quot;)
  514. _PropertyGet = _Type
  515. Case UCase(&quot;OnApproveCursorMove&quot;), UCase(&quot;OnApproveParameter&quot;), UCase(&quot;OnApproveReset&quot;), UCase(&quot;OnApproveRowChange&quot;) _
  516. , UCase(&quot;OnApproveSubmit&quot;), UCase(&quot;OnConfirmDelete&quot;), UCase(&quot;OnCursorMoved&quot;), UCase(&quot;OnErrorOccurred&quot;) _
  517. , UCase(&quot;OnLoaded&quot;), UCase(&quot;OnReloaded&quot;), UCase(&quot;OnReloading&quot;), UCase(&quot;OnResetted&quot;), UCase(&quot;OnRowChanged&quot;) _
  518. , UCase(&quot;OnUnloaded&quot;), UCase(&quot;OnUnloading&quot;)
  519. _PropertyGet = Utils._GetEventScriptCode(DatabaseForm, psProperty, _Name)
  520. Case UCase(&quot;OrderBy&quot;)
  521. _PropertyGet = _OrderBy
  522. Case UCase(&quot;OrderByOn&quot;)
  523. If DatabaseForm.Order = &quot;&quot; Then _PropertyGet = False Else _PropertyGet = True
  524. Case UCase(&quot;Parent&quot;) &apos; Only for indirect access from property object
  525. _PropertyGet = Parent
  526. Case UCase(&quot;Recordset&quot;)
  527. If DatabaseForm.Command = &quot;&quot; Then Goto Trace_Error &apos; No underlying data ??
  528. Set oObject = New Recordset
  529. With DatabaseForm
  530. Set oObject._This = oObject
  531. oObject._CommandType = .CommandType
  532. oObject._Command = .Command
  533. oObject._ParentName = _Name
  534. oObject._ParentType = _Type
  535. Set oDatabase = Application._CurrentDb(_DocEntry, _DbEntry)
  536. Set oObject._ParentDatabase = oDatabase
  537. Set oObject._ParentDatabase.Connection = .ActiveConnection
  538. oObject._ForwardOnly = ( .ResultSetType = com.sun.star.sdbc.ResultSetType.FORWARD_ONLY )
  539. oObject._PassThrough = ( .EscapeProcessing = False )
  540. oObject._ReadOnly = ( .ResultSetConcurrency = com.sun.star.sdbc.ResultSetConcurrency.READ_ONLY )
  541. Call oObject._Initialize()
  542. End With
  543. With oDatabase
  544. .RecordsetMax = .RecordsetMax + 1
  545. oObject._Name = Format(.RecordsetMax, &quot;0000000&quot;)
  546. .RecordsetsColl.Add(oObject, UCase(oObject._Name))
  547. End With
  548. Set _PropertyGet = oObject
  549. Case UCase(&quot;RecordSource&quot;)
  550. _PropertyGet = DatabaseForm.Command
  551. Case Else
  552. Goto Trace_Error
  553. End Select
  554. Exit_Function:
  555. Utils._ResetCalledSub(&quot;SubForm.get&quot; &amp; psProperty)
  556. Exit Function
  557. Trace_Error:
  558. TraceError(TRACEWARNING, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty)
  559. _PropertyGet = EMPTY
  560. Goto Exit_Function
  561. Trace_Error_Index:
  562. TraceError(TRACEFATAL, ERRINDEXVALUE, Utils._CalledSub(), 0, 1, psProperty)
  563. _PropertyGet = EMPTY
  564. Goto Exit_Function
  565. Error_Function:
  566. TraceError(TRACEABORT, Err, &quot;SubForm._PropertyGet&quot;, Erl)
  567. _PropertyGet = EMPTY
  568. GoTo Exit_Function
  569. End Function &apos; _PropertyGet
  570. REM -----------------------------------------------------------------------------------------------------------------------
  571. Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Variant) As Boolean
  572. Utils._SetCalledSub(&quot;SubForm.set&quot; &amp; psProperty)
  573. If _ErrorHandler() Then On Local Error Goto Error_Function
  574. _PropertySet = True
  575. &apos;Execute
  576. Dim iArgNr As Integer
  577. If _IsLeft(_A2B_.CalledSub, &quot;SubForm.&quot;) Then iArgNr = 1 Else iArgNr = 2
  578. Select Case UCase(psProperty)
  579. Case UCase(&quot;AllowAdditions&quot;)
  580. If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value
  581. DatabaseForm.AllowInserts = pvValue
  582. DatabaseForm.reload()
  583. Case UCase(&quot;AllowDeletions&quot;)
  584. If Not Utils._CheckArgument(pvValue,iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value
  585. DatabaseForm.AllowDeletes = pvValue
  586. DatabaseForm.reload()
  587. Case UCase(&quot;AllowEdits&quot;)
  588. If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value
  589. DatabaseForm.AllowUpdates = pvValue
  590. DatabaseForm.reload()
  591. Case UCase(&quot;CurrentRecord&quot;)
  592. If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
  593. DatabaseForm.absolute(pvValue)
  594. Case UCase(&quot;Filter&quot;)
  595. If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
  596. DatabaseForm.Filter = Application._CurrentDb(_DocEntry, _DbEntry)._ReplaceSquareBrackets(pvValue)
  597. Case UCase(&quot;FilterOn&quot;)
  598. If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value
  599. DatabaseForm.ApplyFilter = pvValue
  600. DatabaseForm.reload()
  601. Case UCase(&quot;OnApproveCursorMove&quot;), UCase(&quot;OnApproveParameter&quot;), UCase(&quot;OnApproveReset&quot;), UCase(&quot;OnApproveRowChange&quot;) _
  602. , UCase(&quot;OnApproveSubmit&quot;), UCase(&quot;OnConfirmDelete&quot;), UCase(&quot;OnCursorMoved&quot;), UCase(&quot;OnErrorOccurred&quot;) _
  603. , UCase(&quot;OnLoaded&quot;), UCase(&quot;OnReloaded&quot;), UCase(&quot;OnReloading&quot;), UCase(&quot;OnResetted&quot;), UCase(&quot;OnRowChanged&quot;) _
  604. , UCase(&quot;OnUnloaded&quot;), UCase(&quot;OnUnloading&quot;)
  605. If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
  606. If Not Utils._RegisterEventScript(DatabaseForm _
  607. , psProperty _
  608. , _GetListener(psProperty) _
  609. , pvValue, _Name _
  610. ) Then GoTo Trace_Error
  611. Case UCase(&quot;OrderBy&quot;)
  612. If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
  613. _OrderBy = Application._CurrentDb(_DocEntry, _DbEntry)._ReplaceSquareBrackets(pvValue)
  614. Case UCase(&quot;OrderByOn&quot;)
  615. If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value
  616. If pvValue Then DatabaseForm.Order = _OrderBy Else DatabaseForm.Order = &quot;&quot;
  617. DatabaseForm.reload()
  618. Case UCase(&quot;RecordSource&quot;)
  619. If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
  620. DatabaseForm.Command = Application._CurrentDb(_DocEntry, _DbEntry)._ReplaceSquareBrackets(pvValue)
  621. DatabaseForm.CommandType = com.sun.star.sdb.CommandType.COMMAND
  622. DatabaseForm.Filter = &quot;&quot;
  623. DatabaseForm.reload()
  624. Case Else
  625. Goto Trace_Error
  626. End Select
  627. Exit_Function:
  628. Utils._ResetCalledSub(&quot;SubForm.set&quot; &amp; psProperty)
  629. Exit Function
  630. Trace_Error:
  631. TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty)
  632. _PropertySet = False
  633. Goto Exit_Function
  634. Trace_Error_Value:
  635. TraceError(TRACEFATAL, ERRPROPERTYVALUE, Utils._CalledSub(), 0, 1, Array(pvValue, psProperty))
  636. _PropertySet = False
  637. Goto Exit_Function
  638. Error_Function:
  639. TraceError(TRACEABORT, Err, &quot;SubForm._PropertySet&quot;, Erl)
  640. _PropertySet = False
  641. GoTo Exit_Function
  642. End Function &apos; _PropertySet
  643. </script:module>