diff options
Diffstat (limited to 'wizards/source/access2base/Form.xba')
| -rw-r--r-- | wizards/source/access2base/Form.xba | 1129 |
1 files changed, 1129 insertions, 0 deletions
diff --git a/wizards/source/access2base/Form.xba b/wizards/source/access2base/Form.xba new file mode 100644 index 000000000..df18feb34 --- /dev/null +++ b/wizards/source/access2base/Form.xba @@ -0,0 +1,1129 @@ +<?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="Form" 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 FORM +Private _This As Object ' Workaround for absence of This builtin function +Private _Parent As Object +Private _Shortcut As String +Private _Name As String +Private _DocEntry As Integer ' Doc- and DbContainer entries in Root structure +Private _DbEntry As Integer +Private _MainForms As Variant +Private _PersistentName As String +Private _IsLoaded As Boolean +Private _OpenArgs As Variant +Private _OrderBy As String +Public Component As Object ' com.sun.star.text.TextDocument +Public ContainerWindow As Object ' (No name) +Public FormsCollection As Object ' com.sun.star.form.OFormsCollection +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 = OBJFORM + Set _This = Nothing + Set _Parent = Nothing + _Shortcut = "" + _Name = "" + _DocEntry = -1 + _DbEntry = -1 + _MainForms = Array() + _PersistentName = "" + _IsLoaded = False + _OpenArgs = "" + _OrderBy = "" + Set Component = Nothing + Set ContainerWindow = Nothing + Set FormsCollection = 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() +Dim ofForm As Object + If Not IsLoaded(True) Then + If Not IsNull(DatabaseForm) Then DatabaseForm.Dispose() + End If + 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 Bookmark() As Variant + Bookmark = _PropertyGet("Bookmark") +End Property ' Bookmark (get) + +Property Let Bookmark(ByVal pvValue As Variant) + Call _PropertySet("Bookmark", pvValue) +End Property ' Bookmark (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get Caption() As Variant + Caption = _PropertyGet("Caption") +End Property ' Caption (get) + +Property Let Caption(ByVal pvValue As Variant) + Call _PropertySet("Caption", pvValue) +End Property ' Caption (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 Height() As Variant + Height = _PropertyGet("Height") +End Property ' Height (get) + +Property Let Height(ByVal pvValue As Variant) + Call _PropertySet("Height", pvValue) +End Property ' Height (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Function IsLoaded(ByVal Optional pbForce As Boolean) As Boolean +'Return True if form open +'pbForce = True forbids bypass on value of _IsLoaded + + If _ErrorHandler() Then On Local Error Goto Error_Function + Utils._SetCalledSub("Form.getIsLoaded") + If IsMissing(pbForce) Then pbForce = False + If ( Not pbForce ) And _IsLoaded Then ' For performance reasons, a form object, once detected as loaded, is presumed remaining loaded. Except if pbForce = True + IsLoaded = True + Goto Exit_Function + End If + IsLoaded = False + +Dim oDoc As Object, oDatabase As Object, oEnum As Object, oDesk As Object, oComp As Object, vPersistent As Variant +Dim i As Integer + Set oDoc = _A2B_.CurrentDocument() + Select Case oDoc.DbConnect + Case DBCONNECTBASE + Set oDesk = CreateUnoService("com.sun.star.frame.Desktop") + Set oEnum = oDesk.Components().createEnumeration + Do While oEnum.hasMoreElements ' Search in all open components if one corresponds with current form + oComp = oEnum.nextElement + If _hasUNOProperty(oComp, "Identifier") Then + If oComp.Identifier = "com.sun.star.sdb.FormDesign" Then + vPersistent = Split(oComp.StringValue, "/") + If vPersistent(UBound(vPersistent) - 1) = _PersistentName Then + _IsLoaded = True + Set Component = oComp + Exit Do + End If + End If + End If + Loop + Case DBCONNECTFORM + Set Component = oDoc.Document ' Form + _IsLoaded = True ' Interactive form always loaded by design + End Select + Set oComp = Nothing + IsLoaded = _IsLoaded + +Exit_Function: + Utils._ResetCalledSub("Form.getIsLoaded") + Exit Function +Error_Function: + TraceError(TRACEABORT, Err, "Form.getIsLoaded", Erl) + GoTo Exit_Function +End Function ' IsLoaded V1.1.0 + +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 ----------------------------------------------------------------------------------------------------------------------- +Property Get OpenArgs() As Variant + OpenArgs = _PropertyGet("OpenArgs") +End Property ' OpenArgs (get) + +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 OptionGroup(ByVal Optional pvGroupName As Variant) As Variant +' Return either an error or an object of type OPTIONGROUP based on its name + +Const cstThisSub = "Form.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, CTLPARENTISFORM, Component, FormsCollection) + 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, Form.OptionGroup, Erl) + GoTo Exit_Function +End Function ' OptionGroup V1.1.0 + +REM ----------------------------------------------------------------------------------------------------------------------- +Public Function Parent() As Object + Parent = _Parent +End Function ' Parent (get) V6.4.0 + +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 ----------------------------------------------------------------------------------------------------------------------- +Property Get Visible() As Variant + Visible = _PropertyGet("Visible") +End Property ' Visible (get) + +Property Let Visible(ByVal pvValue As Variant) + Call _PropertySet("Visible", pvValue) +End Property ' Visible (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get Width() As Variant + Width = _PropertyGet("Width") +End Property ' Width (get) + +Property Let Width(ByVal pvValue As Variant) + Call _PropertySet("Width", pvValue) +End Property ' Width (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +REM --- CLASS METHODS --- +REM ----------------------------------------------------------------------------------------------------------------------- + +Public Function mClose() As Variant +' Close the form + +If _ErrorHandler() Then On Local Error Goto Error_Function + Utils._SetCalledSub("Form.Close") + mClose = False +Dim oDatabase As Object, oController As Object + Set oDatabase = Application._CurrentDb() + If oDatabase._DbConnect <> DBCONNECTBASE Then Goto Error_NotApplicable + + Set oController = oDatabase.Document.getFormDocuments.getByHierarchicalName(_Name) + oController.close() + Dispose() + mClose = True + +Exit_Function: + Utils._ResetCalledSub("Form.Close") + Exit Function +Error_NotApplicable: + TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub) + Goto Exit_Function +Error_Function: + TraceError(TRACEABORT, Err, "Form.Close", Erl) + GoTo Exit_Function +End Function ' Close + +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("Form.Controls") + +Dim ocControl As Variant, iControlCount As Integer +Dim oCounter As Variant, sControls() As Variant, i As Integer, bFound As Boolean, sIndex As String +Dim j As Integer, iCount As Integer, sName As String, iAddCount As Integer +Dim oDatabaseForm As Object, iCtlCount As Integer + + Set ocControl = Nothing + If Not IsLoaded Then Goto Trace_Error_NotOpen + 'Count number of controls thru the forms collection + iControlCount = 0 + + iCount = FormsCollection.Count + For i = 0 To iCount - 1 + If i = 0 Then Set oDatabaseForm = DatabaseForm Else Set oDatabaseForm = FormsCollection.getByIndex(i) + If Not IsNull(oDatabaseForm) Then iControlCount = iControlCount + oDatabaseForm.getCount() + Next i + + If IsMissing(pvIndex) Then ' No argument, return Collection pseudo-object + Set oCounter = New Collect + Set oCounter._This = oCounter + oCounter._CollType = COLLCONTROLS + Set 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 + + sName = "" + Select Case VarType(pvIndex) + Case vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbBigint, vbDecimal + If pvIndex < 0 Or pvIndex > iControlCount - 1 Then Goto Trace_Error_Index + iAddCount = 0 + For i = 0 To iCount - 1 + If i = 0 Then Set oDatabaseForm = DatabaseForm Else Set oDatabaseForm = FormsCollection.getByIndex(i) + If Not IsNull(oDatabaseForm) Then + iCtlCount = oDatabaseForm.getCount() + If pvIndex >= iAddCount And pvIndex <= iAddcount + iCtlCount - 1 Then + sName = oDatabaseForm.ElementNames(pvIndex - iAddCount) + Exit For + End If + iAddCount = iAddcount +iCtlCount + End If + Next i + Case vbString ' Check control name validity (non case sensitive) + sIndex = UCase(Utils._Trim(pvIndex)) + bFound = False + For i = 0 To iCount - 1 + If i = 0 Then Set oDatabaseForm = DatabaseForm Else Set oDatabaseForm = FormsCollection.getByIndex(i) + If Not IsNull(oDatabaseForm) Then + sControls() = oDatabaseForm.getElementNames() + For j = 0 To UBound(sControls) + If UCase(sControls(j)) = sIndex Then + sName = sControls(j) + bFound = True + Exit For + End If + Next j + If bFound Then Exit For + End If + Next i + If Not bFound Then Goto Trace_NotFound + End Select + + 'Initialize a new Control object + Set ocControl = New Control + With ocControl + Set ._This = ocControl + Set ._Parent = _This + ._ParentType = CTLPARENTISFORM + ._Name = sName + ._Shortcut = _Shortcut & "!" & Utils._Surround(sName) + If IsNull(oDatabaseForm) Then ._MainForm = "" Else ._MainForm = oDatabaseForm.Name + Set .ControlModel = oDatabaseForm.getByName(sName) + ._ImplementationName = .ControlModel.getImplementationName() + ._FormComponent = Component + If Utils._hasUNOProperty(.ControlModel, "ClassId") Then ._ClassId = .ControlModel.ClassId + If ._ClassId > 0 And ._ClassId <> acHiddenControl Then + Set .ControlView = Component.CurrentController.getControl(.ControlModel) + End If + + ._Initialize() + ._DocEntry = _DocEntry + ._DbEntry = _DbEntry + End With + Set Controls = ocControl + +Exit_Function: + Utils._ResetCalledSub("Form.Controls") + Exit Function +Trace_Error_NotOpen: + TraceError(TRACEFATAL, ERRFORMNOTOPEN, Utils._CalledSub(), 0, , _Name) + Set Controls = Nothing + Goto 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, pvIndex)) + Set Controls = Nothing + Goto Exit_Function +Error_Function: + TraceError(TRACEABORT, Err, "Form.Controls", Erl) + Set Controls = Nothing + GoTo Exit_Function +End Function ' Controls + +REM ----------------------------------------------------------------------------------------------------------------------- +Public Function CurrentDb() As Object +' Returns Database object related to current form + +Const cstThisSub = "Form.CurrentDb" + Utils._SetCalledSub(cstThisSub) + + Set CurrentDb = Application._CurrentDb(_DocEntry, _DbEntry) + +Exit_Function: + Utils._ResetCalledSub(cstThisSub) + Exit Function +End Function ' CurrentDb V1.1.0 + +REM ----------------------------------------------------------------------------------------------------------------------- +Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant +' Return property value of psProperty property name + + Utils._SetCalledSub("Form.getProperty") + If IsMissing(pvProperty) Then Call _TraceArguments() + getProperty = _PropertyGet(pvProperty) + Utils._ResetCalledSub("Form.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 Move( ByVal Optional pvLeft As Variant _ + , ByVal Optional pvTop As Variant _ + , ByVal Optional pvWidth As Variant _ + , ByVal Optional pvHeight As Variant _ + ) As Variant +' Execute Move method + Utils._SetCalledSub("Form.Move") + If _ErrorHandler() Then On Local Error Goto Error_Function + Move = False +Dim iArgNr As Integer + Select Case UCase(_A2B_.CalledSub) + Case UCase("Move") : iArgNr = 1 + Case UCase("Form.Move") : iArgNr = 0 + End Select + If IsMissing(pvLeft) Then pvLeft = -1 + If IsMissing(pvTop) Then pvTop = -1 + If IsMissing(pvWidth) Then pvWidth = -1 + If IsMissing(pvHeight) Then pvHeight = -1 + If Not Utils._CheckArgument(pvLeft, iArgNr + 1, Utils._AddNumeric()) Then Goto Exit_Function + If Not Utils._CheckArgument(pvTop, iArgNr + 2, Utils._AddNumeric()) Then Goto Exit_Function + If Not Utils._CheckArgument(pvWidth, iArgNr + 3, Utils._AddNumeric()) Then Goto Exit_Function + If Not Utils._CheckArgument(pvHeight, iArgNr + 4, Utils._AddNumeric()) Then Goto Exit_Function + +Dim iArg As Integer, iWrong As Integer ' Check arguments values + iArg = 0 + If pvHeight < -1 Then + iArg = 4 : iWrong = pvHeight + ElseIf pvWidth < -1 Then + iArg = 3 : iWrong = pvWidth + ElseIf pvTop < -1 Then + iArg = 2 : iWrong = pvTop + ElseIf pvLeft < -1 Then + iArg = 1 : iWrong = pvLeft + End If + If iArg > 0 Then + TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, 1, Array(iArgNr + iArg, iWrong)) + Goto Exit_Function + End If + +Dim iPosSize As Integer + iPosSize = 0 + If pvLeft >= 0 Then iPosSize = iPosSize + com.sun.star.awt.PosSize.X + If pvTop >= 0 Then iPosSize = iPosSize + com.sun.star.awt.PosSize.Y + If pvWidth > 0 Then iPosSize = iPosSize + com.sun.star.awt.PosSize.WIDTH + If pvHeight > 0 Then iPosSize = iPosSize + com.sun.star.awt.PosSize.HEIGHT + If iPosSize > 0 Then + If Utils._hasUNOProperty(ContainerWindow, "IsMaximized") Then ' Ignored when <= OO3.2 + ContainerWindow.IsMaximized = False + ContainerWindow.IsMinimized = False + End If + ContainerWindow.setPosSize(pvLeft, pvTop, pvWidth, pvHeight, iPosSize) + End If + Move = True + +Exit_Function: + Utils._ResetCalledSub("Form.Move") + Exit Function +Error_Function: + TraceError(TRACEABORT, Err, "Form.Move", Erl) + GoTo Exit_Function +End Function ' Move + +REM ----------------------------------------------------------------------------------------------------------------------- +Public Function Refresh() As Boolean +' Refresh data with its most recent value in the database in a form or subform + Utils._SetCalledSub("Form.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("Form.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("Form.Requery") + If _ErrorHandler() Then On Local Error Goto Error_Function + Requery = False + + DatabaseForm.reload() + Requery = True + +Exit_Function: + Utils._ResetCalledSub("Form.Requery") + Exit Function +Error_Function: + TraceError(TRACEABORT, Err, "Form.Requery", Erl) + GoTo Exit_Function +End Function ' Requery + +REM ----------------------------------------------------------------------------------------------------------------------- +Public Function setFocus() As Boolean +' Execute setFocus method +Const cstThisSub = "Form.setFocus" + Utils._SetCalledSub(cstThisSub) + If _ErrorHandler() Then On Local Error Goto Error_Function + setFocus = False + + With ContainerWindow + If .isVisible() = False Then .setVisible(True) + .IsMinimized = False + .setFocus() + .setEnable(True) ' Added to try to bypass desynchro issue in Linux + .toFront() ' Added to force window change in Linux + End With + setFocus = True + +Exit_Function: + Utils._ResetCalledSub(cstThisSub) + Exit Function +Error_Function: + TraceError(TRACEABORT, Err, cstThisSub, Erl) + Goto Exit_Function +End Function ' setFocus V1.1.0 + +REM ----------------------------------------------------------------------------------------------------------------------- +Public Function setProperty(ByVal Optional psProperty As String, ByVal Optional pvValue As Variant) As Boolean +' Return True if property setting OK + Utils._SetCalledSub("Form.setProperty") + setProperty = _PropertySet(psProperty, pvValue) + Utils._ResetCalledSub("Form.setProperty") +End Function + +REM ----------------------------------------------------------------------------------------------------------------------- +REM --- PRIVATE FUNCTIONS --- +REM ----------------------------------------------------------------------------------------------------------------------- + +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 ----------------------------------------------------------------------------------------------------------------------- +Public Sub _Initialize(psName As String) +' Set pointers to UNO objects + +Dim oDoc As Object, oDatabase As Object + If _ErrorHandler() Then On Local Error Goto Trace_Error + _Name = psName + _Shortcut = "Forms!" & Utils._Surround(psName) + Set oDoc = _A2B_.CurrentDocument() + If oDoc.DbConnect = DBCONNECTBASE Then _PersistentName = oDoc.Document.getFormDocuments().getByHierarchicalName(psName).PersistentName + If IsLoaded Then + Select Case oDoc.DbConnect + Case DBCONNECTBASE + If Not IsNull(Component.CurrentController) Then ' A form opened then closed afterwards keeps a Component attribute + Set ContainerWindow = Component.CurrentController.Frame.ContainerWindow + Set FormsCollection = Component.getDrawPage.Forms + If FormsCollection.Count = 0 Then + Set DatabaseForm = Nothing + Else + 'Only first member of the collection can be reached with A2B + 'Compliant with MSAccess which has 1 datasource by form, while LO might have many + _MainForms = FormsCollection.ElementNames() + Set DatabaseForm = FormsCollection.getByIndex(0) + End If + End If + Case DBCONNECTFORM + Set ContainerWindow = oDoc.Document.CurrentController.Frame.ContainerWindow + Set FormsCollection = oDoc.Document.getDrawPage.Forms + Set oDatabase = Application._CurrentDb(_DocEntry, _DbEntry) + With oDatabase + Set DatabaseForm = .Form + If IsNull(.Connection) Then + Set .Connection = DatabaseForm.ActiveConnection + If Not IsNull(.Connection) Then + Set .MetaData = .Connection.MetaData + oDatabase._ReadOnly = .Connection.isReadOnly() + End If + End If + End With + End Select + If IsNull(DatabaseForm) Then _OrderBy = "" Else _OrderBy = DatabaseForm.Order + Else + Set Component = Nothing + Set ContainerWindow = Nothing + Set DatabaseForm = Nothing + End If + +Exit_Sub: + Exit Sub +Trace_Error: + TraceError(TRACEABORT, Err, "Form.Initialize", Erl) + Goto Exit_Sub +Trace_Internal_Error: + TraceError(TRACEABORT, ERRFORMNOTIDENTIFIED, Utils._CalledSub(), 0, , _Name) + Goto Exit_Sub +End Sub ' _Initialize V1.1.0 + +REM ----------------------------------------------------------------------------------------------------------------------- +Private Function _PropertiesList() As Variant + + If _IsLoaded Then + _PropertiesList = Array("AllowAdditions", "AllowDeletions", "AllowEdits", "Bookmark" _ + , "Caption", "CurrentRecord", "Filter", "FilterOn", "Height", "IsLoaded" _ + , "Name", "ObjectType", "OnApproveCursorMove", "OnApproveParameter" _ + , "OnApproveReset", "OnApproveRowChange", "OnApproveSubmit", "OnConfirmDelete" _ + , "OnCursorMoved", "OnErrorOccurred", "OnLoaded", "OnReloaded", "OnReloading" _ + , "OnResetted", "OnRowChanged", "OnUnloaded", "OnUnloading", "OpenArgs" _ + , "OrderBy", "OrderByOn", "RecordSource", "Visible", "Width" _ + ) ' Recordset removed + Else + _PropertiesList = Array("IsLoaded", "Name" _ + ) + End If + +End Function ' _PropertiesList + +REM ----------------------------------------------------------------------------------------------------------------------- +Private Function _PropertyGet(ByVal psProperty As String) As Variant +' Return property value of the psProperty property name + + If _ErrorHandler() Then On Local Error Goto Error_Function + Utils._SetCalledSub("Form.get" & psProperty) + +'Execute +Dim oDatabase As Object, vBookmark As Variant +Dim i As Integer, oObject As Object + + _PropertyGet = EMPTY + + Select Case UCase(psProperty) + Case UCase("Name"), UCase("IsLoaded") + Case Else : If Not IsLoaded Then Goto Trace_Error_Form + End Select + + Select Case UCase(psProperty) + Case UCase("AllowAdditions") + If IsNull(DatabaseForm) Then _PropertyGet = False Else _PropertyGet = DatabaseForm.AllowInserts + Case UCase("AllowDeletions") + If IsNull(DatabaseForm) Then _PropertyGet = False Else _PropertyGet = DatabaseForm.AllowDeletes + Case UCase("AllowEdits") + If IsNull(DatabaseForm) Then _PropertyGet = False Else _PropertyGet = DatabaseForm.AllowUpdates + Case UCase("Bookmark") + If IsNull(DatabaseForm) Then + _PropertyGet = 0 + Else + On Local Error Resume Next ' Disable error handler because bookmarking does not always react well in events ... + If DatabaseForm.IsBookmarkable Then vBookmark = DatabaseForm.getBookmark() Else vBookmark = Nothing + If _ErrorHandler() Then On Local Error Goto Error_Function Else On Local Error Goto 0 + If IsNull(vBookmark) Then Goto Trace_Error + _PropertyGet = vBookmark + End If + Case UCase("Caption") + Set odatabase = Application._CurrentDb(_DocEntry, _DbEntry) + Select Case oDatabase._DbConnect + Case DBCONNECTFORM : _PropertyGet = oDatabase.Document.CurrentController.Frame.Title + Case DBCONNECTBASE : _PropertyGet = Component.CurrentController.Frame.Title + End Select + Case UCase("CurrentRecord") + If IsNull(DatabaseForm) Then _PropertyGet = 0 Else _PropertyGet = DatabaseForm.Row + Case UCase("Filter") + If IsNull(DatabaseForm) Then _PropertyGet = "" Else _PropertyGet = DatabaseForm.Filter + Case UCase("FilterOn") + If IsNull(DatabaseForm) Then _PropertyGet = False Else _PropertyGet = DatabaseForm.ApplyFilter + Case UCase("Height") + _PropertyGet = ContainerWindow.getPosSize().Height + Case UCase("IsLoaded") ' Only for indirect access from property object + _PropertyGet = IsLoaded + 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") + If IsNull(DatabaseForm) Then _PropertyGet = "" Else _PropertyGet = Utils._GetEventScriptCode(DatabaseForm, psProperty, _Name, True) + Case UCase("OpenArgs") + _PropertyGet = _OpenArgs + Case UCase("OrderBy") + _PropertyGet = _OrderBy + Case UCase("OrderByOn") + If IsNull(DatabaseForm) Then _PropertyGet = False Else _PropertyGet = ( DatabaseForm.Order <> "" ) + Case UCase("Recordset") + If IsNull(DatabaseForm) Then Goto Trace_Error + If DatabaseForm.Command = "" Then Goto Trace_Error ' No underlying data ?? + Set oObject = New Recordset + With DatabaseForm + 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 + If Not ( oObject._BOF And oObject._EOF ) Then oObject.MoveFirst() ' Do nothing if resultset empty + Set _PropertyGet = oObject + Case UCase("RecordSource") + If IsNull(DatabaseForm) Then _PropertyGet = "" Else _PropertyGet = DatabaseForm.Command + Case UCase("Visible") + _PropertyGet = ContainerWindow.IsVisible() + Case UCase("Width") + _PropertyGet = ContainerWindow.getPosSize().Width + Case Else + Goto Trace_Error + End Select + +Exit_Function: + Utils._ResetCalledSub("Form.get" & psProperty) + Exit Function +Trace_Error: + TraceError(TRACEWARNING, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty) + _PropertyGet = EMPTY + Goto Exit_Function +Trace_Error_Form: + TraceError(TRACEFATAL, ERRFORMNOTOPEN, Utils._CalledSub(), 0, 1, _Name) + _PropertyGet = EMPTY + Goto Exit_Function +Error_Function: + TraceError(TRACEABORT, Err, "Form._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("Form.set" & psProperty) + If _ErrorHandler() Then On Local Error Goto Error_Function + _PropertySet = True + +'Execute +Dim iArgNr As Integer, i As Integer +Dim oDatabase As Object + + If _Isleft(_A2B_.CalledSub, "Form.") Then iArgNr = 1 Else iArgNr = 2 + If Not IsLoaded Then Goto Trace_Error_Form + + Select Case UCase(psProperty) + Case UCase("AllowAdditions") + If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value + If IsNull(DatabaseForm) Then Goto Trace_Error + DatabaseForm.AllowInserts = pvValue + DatabaseForm.reload() + Case UCase("AllowDeletions") + If Not Utils._CheckArgument(pvValue,iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value + If IsNull(DatabaseForm) Then Goto Trace_Error + DatabaseForm.AllowDeletes = pvValue + DatabaseForm.reload() + Case UCase("AllowEdits") + If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value + If IsNull(DatabaseForm) Then Goto Trace_Error + DatabaseForm.AllowUpdates = pvValue + DatabaseForm.reload() + Case UCase("Bookmark") + If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(vbObject), , False) Then Goto Trace_Error_Value + If IsNull(pvValue) Then Goto Trace_Error_Value + If IsNull(DatabaseForm) Then Goto Trace_Error + DatabaseForm.MoveToBookmark(pvValue) + Case UCase("Caption") + If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value + Set oDatabase = Application._CurrentDb(_DocEntry, _DbEntry) + Select Case oDatabase._DbConnect + Case DBCONNECTFORM : oDatabase.Document.CurrentController.Frame.Title = pvValue + Case DBCONNECTBASE : Component.CurrentController.Frame.Title = pvValue + End Select + Case UCase("CurrentRecord") + If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value + If pvValue < 1 Then Goto Trace_Error_Value + If IsNull(DatabaseForm) Then Goto Trace_Error + DatabaseForm.absolute(pvValue) + Case UCase("Filter") + If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value + If IsNull(DatabaseForm) Then Goto Trace_Error + DatabaseForm.Filter = Application._CurrentDb(_DocEntry, _DbEntry)._ReplaceSquareBrackets(pvValue) + Case UCase("FilterOn") + If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value + If IsNull(DatabaseForm) Then Goto Trace_Error + DatabaseForm.ApplyFilter = pvValue + DatabaseForm.reload() + Case UCase("Height") + If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value + If Utils._hasUNOProperty(ContainerWindow, "IsMaximized") Then ' Ignored when <= OO3.2 + ContainerWindow.IsMaximized = False + ContainerWindow.IsMinimized = False + End If + ContainerWindow.setPosSize(0, 0, 0, pvValue, com.sun.star.awt.PosSize.HEIGHT) + 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 IsNull(DatabaseForm) Then Goto Trace_Error + If Not Utils._RegisterEventScript(DatabaseForm _ + , psProperty _ + , _GetListener(psProperty) _ + , pvValue, _Name, True _ + ) Then GoTo Trace_Error + Case UCase("OrderBy") + If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value + If IsNull(DatabaseForm) Then Goto Trace_Error + _OrderBy = Application._CurrentDb(_DocEntry, _DbEntry)._ReplaceSquareBrackets(pvValue) + Case UCase("OrderByOn") + If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value + If IsNull(DatabaseForm) Then Goto Trace_Error + 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 + If IsNull(DatabaseForm) Then Goto Trace_Error + DatabaseForm.Command = Application._CurrentDb(_DocEntry, _DbEntry)._ReplaceSquareBrackets(pvValue) + DatabaseForm.CommandType = com.sun.star.sdb.CommandType.COMMAND + DatabaseForm.Filter = "" + DatabaseForm.reload() + Case UCase("Visible") + If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value + ContainerWindow.setVisible(pvValue) + Case UCase("Width") + If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric()) Then Goto Trace_Error_Value + If Utils._hasUNOProperty(ContainerWindow, "IsMaximized") Then ' Ignored when <= OO3.2 + ContainerWindow.IsMaximized = False + ContainerWindow.IsMinimized = False + End If + ContainerWindow.setPosSize(0, 0, pvValue, 0, com.sun.star.awt.PosSize.WIDTH) + Case Else + Goto Trace_Error + End Select + +Exit_Function: + Utils._ResetCalledSub("Form.set" & psProperty) + Exit Function +Trace_Error_Form: + TraceError(TRACEFATAL, ERRFORMNOTOPEN, Utils._CalledSub(), 0, 1, _Name) + _PropertySet = False + Goto 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, "Form._PropertySet", Erl) + _PropertySet = False + GoTo Exit_Function +End Function ' _PropertySet + +</script:module>
\ No newline at end of file |