Server : Apache/2.4.6 (CentOS) OpenSSL/1.0.2k-fips PHP/7.4.20 System : Linux st2.domain.com 3.10.0-1127.10.1.el7.x86_64 #1 SMP Wed Jun 3 14:28:03 UTC 2020 x86_64 User : apache ( 48) PHP Version : 7.4.20 Disable Function : NONE Directory : /opt/libreoffice6.4/share/basic/Access2Base/ |
<?xml version="1.0" encoding="UTF-8"?> <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> <script:module xmlns:script="http://openoffice.org/2000/script" script:name="SubForm" script:language="StarBasic"> REM ======================================================================================================================= REM === The Access2Base library is a part of the LibreOffice project. === REM === Full documentation is available on http://www.access2base.com === REM ======================================================================================================================= Option Compatible Option ClassModule Option Explicit REM ----------------------------------------------------------------------------------------------------------------------- REM --- CLASS ROOT FIELDS --- REM ----------------------------------------------------------------------------------------------------------------------- Private _Type As String ' Must be SUBFORM Private _This As Object ' Workaround for absence of This builtin function Private _Parent As Object Private _Shortcut As String Private _Name As String Private _MainForm As String Private _DocEntry As Integer Private _DbEntry As Integer Private _OrderBy As String Public ParentComponent As Object ' com.sun.star.text.TextDocument Public DatabaseForm As Object ' com.sun.star.form.component.DataForm and com.sun.star.sdb.ResultSet (a.o.) REM ----------------------------------------------------------------------------------------------------------------------- REM --- CONSTRUCTORS / DESTRUCTORS --- REM ----------------------------------------------------------------------------------------------------------------------- Private Sub Class_Initialize() _Type = OBJSUBFORM Set _This = Nothing Set _Parent = Nothing _Shortcut = "" _Name = "" _MainForm = "" _DocEntry = -1 _DbEntry = -1 _OrderBy = "" Set ParentComponent = Nothing Set DatabaseForm = Nothing End Sub ' Constructor REM ----------------------------------------------------------------------------------------------------------------------- Private Sub Class_Terminate() On Local Error Resume Next Call Class_Initialize() End Sub ' Destructor REM ----------------------------------------------------------------------------------------------------------------------- Public Sub Dispose() Call Class_Terminate() End Sub ' Explicit destructor REM ----------------------------------------------------------------------------------------------------------------------- REM --- CLASS GET/LET/SET PROPERTIES --- REM ----------------------------------------------------------------------------------------------------------------------- Property Get AllowAdditions() As Variant AllowAdditions = _PropertyGet("AllowAdditions") End Property ' AllowAdditions (get) Property Let AllowAdditions(ByVal pvValue As Variant) Call _PropertySet("AllowAdditions", pvValue) End Property ' AllowAdditions (set) REM ----------------------------------------------------------------------------------------------------------------------- Property Get AllowDeletions() As Variant AllowDeletions = _PropertyGet("AllowDeletions") End Property ' AllowDeletions (get) Property Let AllowDeletions(ByVal pvValue As Variant) Call _PropertySet("AllowDeletions", pvValue) End Property ' AllowDeletions (set) REM ----------------------------------------------------------------------------------------------------------------------- Property Get AllowEdits() As Variant AllowEdits = _PropertyGet("AllowEdits") End Property ' AllowEdits (get) Property Let AllowEdits(ByVal pvValue As Variant) Call _PropertySet("AllowEdits", pvValue) End Property ' AllowEdits (set) REM ----------------------------------------------------------------------------------------------------------------------- Property Get CurrentRecord() As Variant CurrentRecord = _PropertyGet("CurrentRecord") End Property ' CurrentRecord (get) Property Let CurrentRecord(ByVal pvValue As Variant) Call _PropertySet("CurrentRecord", pvValue) End Property ' CurrentRecord (set) REM ----------------------------------------------------------------------------------------------------------------------- Property Get Filter() As Variant Filter = _PropertyGet("Filter") End Property ' Filter (get) Property Let Filter(ByVal pvValue As Variant) Call _PropertySet("Filter", pvValue) End Property ' Filter (set) REM ----------------------------------------------------------------------------------------------------------------------- Property Get FilterOn() As Variant FilterOn = _PropertyGet("FilterOn") End Property ' FilterOn (get) Property Let FilterOn(ByVal pvValue As Variant) Call _PropertySet("FilterOn", pvValue) End Property ' FilterOn (set) REM ----------------------------------------------------------------------------------------------------------------------- Property Get LinkChildFields(ByVal Optional pvIndex As Variant) As Variant If IsMissing(pvIndex) Then LinkChildFields = _PropertyGet("LinkChildFields") Else LinkChildFields = _PropertyGet("LinkChildFields", pvIndex) End Property ' LinkChildFields (get) REM ----------------------------------------------------------------------------------------------------------------------- Property Get LinkMasterFields(ByVal Optional pvIndex As Variant) As Variant If IsMissing(pvIndex) Then LinkMasterFields = _PropertyGet("LinkMasterFields") Else LinkMasterFields = _PropertyGet("LinkMasterFields", pvIndex) End Property ' LinkMasterFields (get) REM ----------------------------------------------------------------------------------------------------------------------- Property Get Name() As String Name = _PropertyGet("Name") End Property ' Name (get) Public Function pName() As String ' For compatibility with < V0.9.0 pName = _PropertyGet("Name") End Function ' pName (get) REM ----------------------------------------------------------------------------------------------------------------------- Property Get ObjectType() As String ObjectType = _PropertyGet("ObjectType") End Property ' ObjectType (get) REM ----------------------------------------------------------------------------------------------------------------------- Property Get OnApproveCursorMove() As Variant OnApproveCursorMove = _PropertyGet("OnApproveCursorMove") End Property ' OnApproveCursorMove (get) Property Let OnApproveCursorMove(ByVal pvValue As Variant) Call _PropertySet("OnApproveCursorMove", pvValue) End Property ' OnApproveCursorMove (set) REM ----------------------------------------------------------------------------------------------------------------------- Property Get OnApproveParameter() As Variant OnApproveParameter = _PropertyGet("OnApproveParameter") End Property ' OnApproveParameter (get) Property Let OnApproveParameter(ByVal pvValue As Variant) Call _PropertySet("OnApproveParameter", pvValue) End Property ' OnApproveParameter (set) REM ----------------------------------------------------------------------------------------------------------------------- Property Get OnApproveReset() As Variant OnApproveReset = _PropertyGet("OnApproveReset") End Property ' OnApproveReset (get) Property Let OnApproveReset(ByVal pvValue As Variant) Call _PropertySet("OnApproveReset", pvValue) End Property ' OnApproveReset (set) REM ----------------------------------------------------------------------------------------------------------------------- Property Get OnApproveRowChange() As Variant OnApproveRowChange = _PropertyGet("OnApproveRowChange") End Property ' OnApproveRowChange (get) Property Let OnApproveRowChange(ByVal pvValue As Variant) Call _PropertySet("OnApproveRowChange", pvValue) End Property ' OnApproveRowChange (set) REM ----------------------------------------------------------------------------------------------------------------------- Property Get OnApproveSubmit() As Variant OnApproveSubmit = _PropertyGet("OnApproveSubmit") End Property ' OnApproveSubmit (get) Property Let OnApproveSubmit(ByVal pvValue As Variant) Call _PropertySet("OnApproveSubmit", pvValue) End Property ' OnApproveSubmit (set) REM ----------------------------------------------------------------------------------------------------------------------- Property Get OnConfirmDelete() As Variant OnConfirmDelete = _PropertyGet("OnConfirmDelete") End Property ' OnConfirmDelete (get) Property Let OnConfirmDelete(ByVal pvValue As Variant) Call _PropertySet("OnConfirmDelete", pvValue) End Property ' OnConfirmDelete (set) REM ----------------------------------------------------------------------------------------------------------------------- Property Get OnCursorMoved() As Variant OnCursorMoved = _PropertyGet("OnCursorMoved") End Property ' OnCursorMoved (get) Property Let OnCursorMoved(ByVal pvValue As Variant) Call _PropertySet("OnCursorMoved", pvValue) End Property ' OnCursorMoved (set) REM ----------------------------------------------------------------------------------------------------------------------- Property Get OnErrorOccurred() As Variant OnErrorOccurred = _PropertyGet("OnErrorOccurred") End Property ' OnErrorOccurred (get) Property Let OnErrorOccurred(ByVal pvValue As Variant) Call _PropertySet("OnErrorOccurred", pvValue) End Property ' OnErrorOccurred (set) REM ----------------------------------------------------------------------------------------------------------------------- Property Get OnLoaded() As Variant OnLoaded = _PropertyGet("OnLoaded") End Property ' OnLoaded (get) Property Let OnLoaded(ByVal pvValue As Variant) Call _PropertySet("OnLoaded", pvValue) End Property ' OnLoaded (set) REM ----------------------------------------------------------------------------------------------------------------------- Property Get OnReloaded() As Variant OnReloaded = _PropertyGet("OnReloaded") End Property ' OnReloaded (get) Property Let OnReloaded(ByVal pvValue As Variant) Call _PropertySet("OnReloaded", pvValue) End Property ' OnReloaded (set) REM ----------------------------------------------------------------------------------------------------------------------- Property Get OnReloading() As Variant OnReloading = _PropertyGet("OnReloading") End Property ' OnReloading (get) Property Let OnReloading(ByVal pvValue As Variant) Call _PropertySet("OnReloading", pvValue) End Property ' OnReloading (set) REM ----------------------------------------------------------------------------------------------------------------------- Property Get OnResetted() As Variant OnResetted = _PropertyGet("OnResetted") End Property ' OnResetted (get) Property Let OnResetted(ByVal pvValue As Variant) Call _PropertySet("OnResetted", pvValue) End Property ' OnResetted (set) REM ----------------------------------------------------------------------------------------------------------------------- Property Get OnRowChanged() As Variant OnRowChanged = _PropertyGet("OnRowChanged") End Property ' OnRowChanged (get) Property Let OnRowChanged(ByVal pvValue As Variant) Call _PropertySet("OnRowChanged", pvValue) End Property ' OnRowChanged (set) REM ----------------------------------------------------------------------------------------------------------------------- Property Get OnUnloaded() As Variant OnUnloaded = _PropertyGet("OnUnloaded") End Property ' OnUnloaded (get) Property Let OnUnloaded(ByVal pvValue As Variant) Call _PropertySet("OnUnloaded", pvValue) End Property ' OnUnloaded (set) REM ----------------------------------------------------------------------------------------------------------------------- Property Get OnUnloading() As Variant OnUnloading = _PropertyGet("OnUnloading") End Property ' OnUnloading (get) Property Let OnUnloading(ByVal pvValue As Variant) Call _PropertySet("OnUnloading", pvValue) End Property ' OnUnloading (set) REM ----------------------------------------------------------------------------------------------------------------------- Public Function OptionGroup(ByVal Optional pvGroupName As Variant) As Variant ' Return either an error or an object of type OPTIONGROUP based on its name Const cstThisSub = "SubForm.OptionGroup" Dim ogGroup As Object Utils._SetCalledSub(cstThisSub) If IsMissing(pvGroupName) Then Call _TraceArguments() If _ErrorHandler() Then On Local Error Goto Error_Function Set ogGroup = _OptionGroup(pvGroupName, CTLPARENTISSUBFORM, ParentComponent, DatabaseForm) If Not IsNull(ogGroup) Then ogGroup._DocEntry = _DocEntry ogGroup._DbEntry = _DbEntry End If Set OptionGroup = ogGroup Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) GoTo Exit_Function End Function ' OptionGroup V1.1.0 REM ----------------------------------------------------------------------------------------------------------------------- Property Get OrderBy() As Variant OrderBy = _PropertyGet("OrderBy") End Property ' OrderBy (get) V1.2.0 Property Let OrderBy(ByVal pvValue As Variant) Call _PropertySet("OrderBy", pvValue) End Property ' OrderBy (set) REM ----------------------------------------------------------------------------------------------------------------------- Property Get OrderByOn() As Variant OrderByOn = _PropertyGet("OrderByOn") End Property ' OrderByOn (get) V1.2.0 Property Let OrderByOn(ByVal pvValue As Variant) Call _PropertySet("OrderByOn", pvValue) End Property ' OrderByOn (set) REM ----------------------------------------------------------------------------------------------------------------------- Public Function Parent() As Object Utils._SetCalledSub("SubForm.getParent") On Error Goto Error_Function Set Parent = _Parent Exit_Function: Utils._ResetCalledSub("SubForm.getParent") Exit Function Error_Function: TraceError(TRACEABORT, Err, "SubForm.getParent", Erl) Set Parent = Nothing GoTo Exit_Function End Function ' Parent REM ----------------------------------------------------------------------------------------------------------------------- Public Function Properties(ByVal Optional pvIndex As Variant) As Variant ' Return ' a Collection object if pvIndex absent ' a Property object otherwise Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String vPropertiesList = _PropertiesList() sObject = Utils._PCase(_Type) If IsMissing(pvIndex) Then vProperty = PropertiesGet._Properties(sObject, _This, vPropertiesList) Else vProperty = PropertiesGet._Properties(sObject, _This, vPropertiesList, pvIndex) vProperty._Value = _PropertyGet(vPropertiesList(pvIndex)) End If Exit_Function: Set Properties = vProperty Exit Function End Function ' Properties REM ----------------------------------------------------------------------------------------------------------------------- Property Get Recordset() As Object Recordset = _PropertyGet("Recordset") End Property ' Recordset (get) V0.9.5 REM ----------------------------------------------------------------------------------------------------------------------- Property Get RecordSource() As Variant RecordSource = _PropertyGet("RecordSource") End Property ' RecordSource (get) Property Let RecordSource(ByVal pvValue As Variant) Call _PropertySet("RecordSource", pvValue) End Property ' RecordSource (set) REM ----------------------------------------------------------------------------------------------------------------------- REM --- CLASS METHODS --- REM ----------------------------------------------------------------------------------------------------------------------- Public Function Controls(Optional ByVal pvIndex As Variant) As Variant ' Return a Control object with name or index = pvIndex If _ErrorHandler() Then On Local Error Goto Error_Function Utils._SetCalledSub("SubForm.Controls") Dim ocControl As Variant, sParentShortcut As String, iControlCount As Integer Dim oCounter As Variant, sControls() As Variant, i As Integer, bFound As Boolean, sIndex As String Dim j As Integer Set ocControl = Nothing iControlCount = DatabaseForm.getCount() If IsMissing(pvIndex) Then ' No argument, return Collection pseudo-object Set oCounter = New Collect Set oCounter._This = oCounter oCounter._CollType = COLLCONTROLS oCounter._Parent = _This oCounter._Count = iControlCount Set Controls = oCounter Goto Exit_Function End If If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function ' Start building the ocControl object ' Determine exact name Set ocControl = New Control Set ocControl._This = ocControl Set ocControl._Parent = _This ocControl._ParentType = CTLPARENTISSUBFORM sParentShortcut = _Shortcut sControls() = DatabaseForm.getElementNames() Select Case VarType(pvIndex) Case vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbBigint, vbDecimal If pvIndex < 0 Or pvIndex > iControlCount - 1 Then Goto Trace_Error_Index ocControl._Name = sControls(pvIndex) Case vbString ' Check control name validity (non case sensitive) bFound = False sIndex = UCase(Utils._Trim(pvIndex)) For i = 0 To iControlCount - 1 If UCase(sControls(i)) = sIndex Then bFound = True Exit For End If Next i If bFound Then ocControl._Name = sControls(i) Else Goto Trace_NotFound End Select With ocControl ._Shortcut = sParentShortcut & "!" & Utils._Surround(._Name) Set .ControlModel = DatabaseForm.getByName(._Name) ._ImplementationName = .ControlModel.getImplementationName() ._FormComponent = ParentComponent If Utils._hasUNOProperty(.ControlModel, "ClassId") Then ._ClassId = .ControlModel.ClassId If ._ClassId > 0 And ._ClassId <> acHiddenControl Then Set .ControlView = ParentComponent.CurrentController.getControl(.ControlModel) End If ._Initialize() ._DocEntry = _DocEntry ._DbEntry = _DbEntry End With Set Controls = ocControl Exit_Function: Utils._ResetCalledSub("SubForm.Controls") Exit Function Trace_Error_Index: TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0, 1) Set Controls = Nothing Goto Exit_Function Trace_NotFound: TraceError(TRACEFATAL, ERRCONTROLNOTFOUND, Utils._CalledSub(), 0, , Array(pvIndex, _Name)) Set Controls = Nothing Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, "SubForm.Controls", Erl) Set Controls = Nothing GoTo Exit_Function End Function ' Controls V1.1.0 REM ----------------------------------------------------------------------------------------------------------------------- Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant ' Return property value of psProperty property name Utils._SetCalledSub("SubForm.getProperty") If IsMissing(pvProperty) Then Call _TraceArguments() getProperty = _PropertyGet(pvProperty) Utils._ResetCalledSub("SubForm.getProperty") End Function ' getProperty REM ----------------------------------------------------------------------------------------------------------------------- Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean ' Return True if object has a valid property called pvProperty (case-insensitive comparison !) If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty) Exit Function End Function ' hasProperty REM ----------------------------------------------------------------------------------------------------------------------- Public Function Refresh() As Boolean ' Refresh data with its most recent value in the database in a form or subform Utils._SetCalledSub("SubForm.Refresh") If _ErrorHandler() Then On Local Error Goto Error_Function Refresh = False Dim oSet As Object Set oSet = DatabaseForm.createResultSet() If Not IsNull(oSet) Then oSet.refreshRow() Refresh = True End If Exit_Function: Set oSet = Nothing Utils._ResetCalledSub("SubForm.Refresh") Exit Function Error_Function: TraceError(TRACEABORT, Err, "SubForm.Refresh", Erl) GoTo Exit_Function End Function ' Refresh REM ----------------------------------------------------------------------------------------------------------------------- Public Function Requery() As Boolean ' Refresh data displayed in a form, subform, combobox or listbox Utils._SetCalledSub("SubForm.Requery") If _ErrorHandler() Then On Local Error Goto Error_Function Requery = False DatabaseForm.reload() Requery = True Exit_Function: Utils._ResetCalledSub("SubForm.Requery") Exit Function Error_Function: TraceError(TRACEABORT, Err, "SubForm.Requery", Erl) GoTo Exit_Function End Function ' Requery REM ----------------------------------------------------------------------------------------------------------------------- Public Function setProperty(ByVal Optional psProperty As String, ByVal Optional pvValue As Variant) As Boolean ' Return True if property setting OK Utils._SetCalledSub("SubForm.setProperty") setProperty = _PropertySet(psProperty, pvValue) Utils._ResetCalledSub("SubForm.setProperty") End Function REM ----------------------------------------------------------------------------------------------------------------------- REM --- PRIVATE FUNCTIONS --- REM ----------------------------------------------------------------------------------------------------------------------- Private Function _GetListener(ByVal psProperty As String) As String ' Return the X...Listener corresponding with the property in argument Select Case UCase(psProperty) Case UCase("OnApproveCursorMove") _GetListener = "XRowSetApproveListener" Case UCase("OnApproveParameter") _GetListener = "XDatabaseParameterListener" Case UCase("OnApproveReset"), UCase("OnResetted") _GetListener = "XResetListener" Case UCase("OnApproveRowChange") _GetListener = "XRowSetApproveListener" Case UCase("OnApproveSubmit") _GetListener = "XSubmitListener" Case UCase("OnConfirmDelete") _GetListener = "XConfirmDeleteListener" Case UCase("OnCursorMoved"), UCase("OnRowChanged") _GetListener = "XRowSetListener" Case UCase("OnErrorOccurred") _GetListener = "XSQLErrorListener" Case UCase("OnLoaded"), UCase("OnReloaded"), UCase("OnReloading"), UCase("OnUnloaded"), UCase("OnUnloading") _GetListener = "XLoadListener" End Select End Function ' _GetListener V1.7.0 REM ----------------------------------------------------------------------------------------------------------------------- Private Function _PropertiesList() As Variant _PropertiesList = Array("AllowAdditions", "AllowDeletions", "AllowEdits", "CurrentRecord" _ , "Filter", "FilterOn", "LinkChildFields", "LinkMasterFields", "Name" _ , "ObjectType", "OnApproveCursorMove", "OnApproveParameter" _ , "OnApproveReset", "OnApproveRowChange", "OnApproveSubmit", "OnConfirmDelete" _ , "OnCursorMoved", "OnErrorOccurred", "OnLoaded", "OnReloaded", "OnReloading" _ , "OnResetted", "OnRowChanged", "OnUnloaded", "OnUnloading", "OrderBy" _ , "OrderByOn", "Parent", "RecordSource" _ ) ' Recordset removed End Function ' _PropertiesList REM ----------------------------------------------------------------------------------------------------------------------- Private Function _PropertyGet(ByVal psProperty As String, ByVal Optional pvIndex As Variant) As Variant ' Return property value of the psProperty property name If _ErrorHandler() Then On Local Error Goto Error_Function Utils._SetCalledSub("SubForm.get" & psProperty) Dim iArgNr As Integer If Not IsMissing(pvIndex) Then Select Case UCase(_A2B_.CalledSub) Case UCase("getProperty") : iArgNr = 3 Case UCase("SubForm.getProperty") : iArgNr = 2 Case UCase("SubForm.get" & psProperty) : iArgNr = 1 End Select If Not Utils._CheckArgument(pvIndex, iArgNr, Utils._AddNumeric()) Then Goto Exit_Function End If 'Execute Dim oDatabase As Object, vBookmark As Variant, oObject As Object _PropertyGet = EMPTY Select Case UCase(psProperty) Case UCase("AllowAdditions") _PropertyGet = DatabaseForm.AllowInserts Case UCase("AllowDeletions") _PropertyGet = DatabaseForm.AllowDeletes Case UCase("AllowEdits") _PropertyGet = DatabaseForm.AllowUpdates Case UCase("CurrentRecord") _PropertyGet = DatabaseForm.Row Case UCase("Filter") _PropertyGet = DatabaseForm.Filter Case UCase("FilterOn") _PropertyGet = DatabaseForm.ApplyFilter Case UCase("LinkChildFields") If Utils._hasUNOProperty(DatabaseForm, "DetailFields") Then If IsMissing(pvIndex) Then _PropertyGet = DatabaseForm.DetailFields Else If pvIndex < 0 Or pvIndex > UBound(DatabaseForm.DetailFields) Then Goto trace_Error_Index _PropertyGet = DatabaseForm.DetailFields(pvIndex) End If End If Case UCase("LinkMasterFields") If Utils._hasUNOProperty(DatabaseForm, "MasterFields") Then If IsMissing(pvIndex) Then _PropertyGet = DatabaseForm.MasterFields Else If pvIndex < 0 Or pvIndex > UBound(DatabaseForm.MasterFields) Then Goto trace_Error_Index _PropertyGet = DatabaseForm.MasterFields(pvIndex) End If End If Case UCase("Name") _PropertyGet = _Name Case UCase("ObjectType") _PropertyGet = _Type Case UCase("OnApproveCursorMove"), UCase("OnApproveParameter"), UCase("OnApproveReset"), UCase("OnApproveRowChange") _ , UCase("OnApproveSubmit"), UCase("OnConfirmDelete"), UCase("OnCursorMoved"), UCase("OnErrorOccurred") _ , UCase("OnLoaded"), UCase("OnReloaded"), UCase("OnReloading"), UCase("OnResetted"), UCase("OnRowChanged") _ , UCase("OnUnloaded"), UCase("OnUnloading") _PropertyGet = Utils._GetEventScriptCode(DatabaseForm, psProperty, _Name) Case UCase("OrderBy") _PropertyGet = _OrderBy Case UCase("OrderByOn") If DatabaseForm.Order = "" Then _PropertyGet = False Else _PropertyGet = True Case UCase("Parent") ' Only for indirect access from property object _PropertyGet = Parent Case UCase("Recordset") If DatabaseForm.Command = "" Then Goto Trace_Error ' No underlying data ?? Set oObject = New Recordset With DatabaseForm Set oObject._This = oObject oObject._CommandType = .CommandType oObject._Command = .Command oObject._ParentName = _Name oObject._ParentType = _Type Set oDatabase = Application._CurrentDb(_DocEntry, _DbEntry) Set oObject._ParentDatabase = oDatabase Set oObject._ParentDatabase.Connection = .ActiveConnection oObject._ForwardOnly = ( .ResultSetType = com.sun.star.sdbc.ResultSetType.FORWARD_ONLY ) oObject._PassThrough = ( .EscapeProcessing = False ) oObject._ReadOnly = ( .ResultSetConcurrency = com.sun.star.sdbc.ResultSetConcurrency.READ_ONLY ) Call oObject._Initialize() End With With oDatabase .RecordsetMax = .RecordsetMax + 1 oObject._Name = Format(.RecordsetMax, "0000000") .RecordsetsColl.Add(oObject, UCase(oObject._Name)) End With Set _PropertyGet = oObject Case UCase("RecordSource") _PropertyGet = DatabaseForm.Command Case Else Goto Trace_Error End Select Exit_Function: Utils._ResetCalledSub("SubForm.get" & psProperty) Exit Function Trace_Error: TraceError(TRACEWARNING, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty) _PropertyGet = EMPTY Goto Exit_Function Trace_Error_Index: TraceError(TRACEFATAL, ERRINDEXVALUE, Utils._CalledSub(), 0, 1, psProperty) _PropertyGet = EMPTY Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, "SubForm._PropertyGet", Erl) _PropertyGet = EMPTY GoTo Exit_Function End Function ' _PropertyGet REM ----------------------------------------------------------------------------------------------------------------------- Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Variant) As Boolean Utils._SetCalledSub("SubForm.set" & psProperty) If _ErrorHandler() Then On Local Error Goto Error_Function _PropertySet = True 'Execute Dim iArgNr As Integer If _IsLeft(_A2B_.CalledSub, "SubForm.") Then iArgNr = 1 Else iArgNr = 2 Select Case UCase(psProperty) Case UCase("AllowAdditions") If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value DatabaseForm.AllowInserts = pvValue DatabaseForm.reload() Case UCase("AllowDeletions") If Not Utils._CheckArgument(pvValue,iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value DatabaseForm.AllowDeletes = pvValue DatabaseForm.reload() Case UCase("AllowEdits") If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value DatabaseForm.AllowUpdates = pvValue DatabaseForm.reload() Case UCase("CurrentRecord") If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value DatabaseForm.absolute(pvValue) Case UCase("Filter") If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value DatabaseForm.Filter = Application._CurrentDb(_DocEntry, _DbEntry)._ReplaceSquareBrackets(pvValue) Case UCase("FilterOn") If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value DatabaseForm.ApplyFilter = pvValue DatabaseForm.reload() Case UCase("OnApproveCursorMove"), UCase("OnApproveParameter"), UCase("OnApproveReset"), UCase("OnApproveRowChange") _ , UCase("OnApproveSubmit"), UCase("OnConfirmDelete"), UCase("OnCursorMoved"), UCase("OnErrorOccurred") _ , UCase("OnLoaded"), UCase("OnReloaded"), UCase("OnReloading"), UCase("OnResetted"), UCase("OnRowChanged") _ , UCase("OnUnloaded"), UCase("OnUnloading") If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value If Not Utils._RegisterEventScript(DatabaseForm _ , psProperty _ , _GetListener(psProperty) _ , pvValue, _Name _ ) Then GoTo Trace_Error Case UCase("OrderBy") If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value _OrderBy = Application._CurrentDb(_DocEntry, _DbEntry)._ReplaceSquareBrackets(pvValue) Case UCase("OrderByOn") If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value If pvValue Then DatabaseForm.Order = _OrderBy Else DatabaseForm.Order = "" DatabaseForm.reload() Case UCase("RecordSource") If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value DatabaseForm.Command = Application._CurrentDb(_DocEntry, _DbEntry)._ReplaceSquareBrackets(pvValue) DatabaseForm.CommandType = com.sun.star.sdb.CommandType.COMMAND DatabaseForm.Filter = "" DatabaseForm.reload() Case Else Goto Trace_Error End Select Exit_Function: Utils._ResetCalledSub("SubForm.set" & psProperty) Exit Function Trace_Error: TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty) _PropertySet = False Goto Exit_Function Trace_Error_Value: TraceError(TRACEFATAL, ERRPROPERTYVALUE, Utils._CalledSub(), 0, 1, Array(pvValue, psProperty)) _PropertySet = False Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, "SubForm._PropertySet", Erl) _PropertySet = False GoTo Exit_Function End Function ' _PropertySet </script:module>