Kaydet (Commit) 83709f8a authored tarafından Jean-Pierre Ledure's avatar Jean-Pierre Ledure

Access2Base - Support hierarchical form names

So far, only a flat list of form names was implemented (by far the majority of cases).
Now, hierarchical form names (like "Folder1/Folder2/myForm") are accepted.

Impacts:
- on AllForms() and Forms() collections:
  - insertion of _GetAllHierarchicalNames() to make list of names
  - insertion of _CollectNames(): recursive function to walk thru folders
  - insertion of _GetHierarchicalName(persistent name) to establist correspondence
- on OpenForm action
- on SelectObject action: form windows are not identified by title anymore
- on form and control events
- on arguments check when argument is a form object

Change-Id: I2da73ac3d4fe2d90b2e526fe510207c0f8ec8386
üst 690cbe7a
......@@ -183,6 +183,12 @@ Type DbContainer
Database As Object ' Database type
End Type
REM -----------------------------------------------------------------------------------------------------------------------
REM --- Next variable is initialized to empty at each macro execution start ---
REM --- Items in both lists correspond one by one ---
Public vFormNamesList As Variant ' (0) Buffer of hierarchical form names => "\;" separated values
' (1) Buffer of persistent form names => "\;" separated values
REM -----------------------------------------------------------------------------------------------------------------------
Public Function AllDialogs(ByVal Optional pvIndex As Variant) As Variant
' Return either a Collection or a Dialog object
......@@ -322,57 +328,61 @@ Public Function AllForms(ByVal Optional pvIndex As Variant) As Variant
' Easiest use for standalone forms: AllForms(0)
' If no argument, return a Collection type
If _ErrorHandler() Then On Local Error Goto Error_Function
Const cstThisSub = "AllForms"
Dim iIndex As Integer, vReturn As Variant
Dim iCurrentDoc As Integer, vCurrentDoc As Variant, oForms As Variant, oCounter As Variant, oFormsCollection As Object
Dim ofForm As Object
Dim vAllForms As Variant, i As Integer, vName As Variant, oDatabase As Object, bFound As Boolean
Const cstSeparator = "\;"
If _ErrorHandler() Then On Local Error Goto Error_Function
Utils._SetCalledSub(cstThisSub)
Dim iIndex As Integer, vAllForms As Variant
Set vAllForms = Nothing
Set vReturn = Nothing
If Not IsMissing(pvIndex) Then
If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function
Select Case VarType(pvIndex)
Case vbString
iIndex = -1
Case vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbBigint, vbDecimal
Case Else
iIndex = pvIndex
End Select
End If
Dim iCurrentDoc As Integer, vCurrentDoc As Variant, oForms As Variant, oCounter As Variant, oFormsCollection As Object
iCurrentDoc = _A2B_.CurrentDocIndex()
If iCurrentDoc >= 0 Then
vCurrentDoc = _A2B_.CurrentDocument(iCurrentDoc)
Else
Goto Exit_Function
End If
If vCurrentDoc.DbConnect = DBCONNECTBASE Then Set oForms = vCurrentDoc.Document.getFormDocuments()
' Load complete list of hierarchical and persistent names when Base document
If vCurrentDoc.DbConnect = DBCONNECTBASE Then vAllForms = _GetAllHierarchicalNames()
' Process when NO ARGUMENT
If IsMissing(pvIndex) Then ' No argument
Set oCounter = New Collect
oCounter._CollType = COLLALLFORMS
oCounter._ParentType = OBJAPPLICATION
oCounter._ParentName = ""
If vCurrentDoc.DbConnect = DBCONNECTFORM Then oCounter._Count = UBound(vCurrentDoc.DbContainers) + 1 Else oCounter._Count = oForms.getCount()
Set vAllForms = oCounter
If vCurrentDoc.DbConnect = DBCONNECTFORM Then oCounter._Count = UBound(vCurrentDoc.DbContainers) + 1 Else oCounter._Count = UBound(vAllForms) + 1
Set vReturn = oCounter
Goto Exit_Function
End If
' Process when ARGUMENT = STRING or INDEX => Initialize form object
Dim ofForm As Object
Set ofForm = New Form
Dim sAllForms As Variant, i As Integer, vName As Variant, oDatabase As Object, bFound As Boolean
Select Case vCurrentDoc.DbConnect
Case DBCONNECTBASE
sAllForms() = oForms.getElementNames()
ofForm._DocEntry = 0
ofForm._DbEntry = 0
If iIndex= -1 Then ' String argument
vName = Utils._InList(Utils._Trim(pvIndex), sAllForms, True) ' hasByName not used because case sensitive
vName = Utils._InList(Utils._Trim(pvIndex), vAllForms, True)
If vName = False Then Goto Trace_Not_Found
ofForm._Initialize(vName)
Else
If iIndex + 1 > oForms.getCount() Or iIndex < 0 Then Goto Trace_Error_Index ' Numeric argument OK but value nonsense
ofForm._Initialize(sAllForms(iIndex))
If iIndex > UBound(vAllForms) Or iIndex < 0 Then Goto Trace_Error_Index ' Numeric argument OK but value nonsense
ofForm._Initialize(vAllForms(iIndex))
End If
Case DBCONNECTFORM
With vCurrentDoc
......@@ -399,10 +409,10 @@ Dim sAllForms As Variant, i As Integer, vName As Variant, oDatabase As Object, b
ofForm._Initialize(vName)
End Select
Set vAllForms = ofForm
Set vReturn = ofForm
Exit_Function:
Set AllForms = vAllForms
Set AllForms = vReturn
Utils._ResetCalledSub(cstThisSub)
Exit Function
Trace_Not_Found:
......@@ -410,11 +420,11 @@ Trace_Not_Found:
Goto Exit_Function
Trace_Error_Index:
TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0, 1)
Set vAllForms = Nothing
Set vReturn = Nothing
Goto Exit_Function
Error_Function:
TraceError(TRACEABORT, Err, cstThisSub, Erl)
Set vAllForms = Nothing
Set vReturn = Nothing
GoTo Exit_Function
End Function ' AllForms V0.9.0
......@@ -1031,11 +1041,10 @@ Dim iCount As Integer
Select Case VarType(pvIndex)
Case vbString
Set ofForm = Application.AllForms(Utils._Trim(pvIndex))
Case vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbBigint, vbDecimal
Case Else
iCount = Application._CountOpenForms()
If iCount <= pvIndex Then Goto Trace_Error_Index
Set ofForm = Application._CountOpenForms(pvIndex)
Case Else
End Select
If IsNull(ofForm) Then Goto Trace_Error
......@@ -1524,6 +1533,53 @@ REM ----------------------------------------------------------------------------
REM --- PRIVATE FUNCTIONS ---
REM -----------------------------------------------------------------------------------------------------------------------
REM -----------------------------------------------------------------------------------------------------------------------
Private Function _CollectNames(ByRef poCollection As Object, ByVal psPrefix As String) As Variant
' Return a "\;" speparated list of hierarchical (prefixed with Prefix) and persistent names contained in Collection
' If one of those names refers to a folder, function is called recursively
' Result = 2 items array: (0) list of hierarchical names
' (1) list of persistent names
'
Dim oObject As Object, vNamesList() As Variant, vPersistentList As Variant, i As Integer, vCollect As Variant
Dim sName As String, sType As String, sPrefix As String
Const cstFormType = "application/vnd.oasis.opendocument.text"
Const cstSeparator = "\;"
_CollectNames = Array()
vCollect = Array()
ReDim vCollect(0 To 1)
vPersistentList = Array()
With poCollection
If .getCount = 0 Then Exit Function
vNamesList = .getElementNames()
ReDim vPersistentList(0 To UBound(vNamesList))
For i = 0 To UBound(vNamesList)
sName = vNamesList(i)
Set oObject = .getByName(sName)
sType = oObject.getContentType()
Select Case sType
Case cstFormType
vNamesList(i) = psPrefix & vNamesList(i)
vPersistentList(i) = oObject.PersistentName
Case "" ' Folder
vCollect = _CollectNames(oObject, psPrefix & sName & "/")
vNamesList(i) = vCollect(0)
vPersistentList(i) = vCollect(1)
Case Else
End Select
Next i
End With
Set oObject = Nothing
vCollect(0) = Join(vNamesList, cstSeparator)
vCollect(1) = Join(vPersistentList, cstSeparator)
_CollectNames = vCollect
End Function ' _CollectNames V6.2.0
REM -----------------------------------------------------------------------------------------------------------------------
Public Function _CountOpenForms(ByVal Optional piCountMax As Integer) As Variant
' Return # of active forms if no argument
......@@ -1535,7 +1591,7 @@ Dim i As Integer, iCount As Integer, iAllCount As Integer, ofForm As Variant
If iAllCount > 0 Then
For i = 0 To iAllCount - 1
Set ofForm = Application.AllForms(i)
If ofForm.IsLoaded Then iCount = iCount + 1
If ofForm._IsLoaded Then iCount = iCount + 1
If Not IsMissing(piCountMax) Then
If iCount = piCountMax + 1 Then
_CountOpenForms = ofForm ' OO3.2 aborts when Set verb present ?!?
......@@ -1567,6 +1623,59 @@ Trace_Error:
Goto Exit_Function
End Function ' _CurrentDb V1.1.0
REM -----------------------------------------------------------------------------------------------------------------------
Private Function _GetAllHierarchicalNames() As Variant
' Return the full hierarchical names list of a database document
' Get it from the vFormNamesList buffer if the latter is not empty
Dim vNamesList As Variant, iCurrentDoc As Integer, vCurrentDoc As Variant
Dim oForms As Object
Const cstSeparator = "\;"
_GetAllHierarchicalNames = Array()
' Load complete list of names when Base document
iCurrentDoc = _A2B_.CurrentDocIndex()
If iCurrentDoc >= 0 Then vCurrentDoc = _A2B_.CurrentDocument(iCurrentDoc) Else Exit Function
If vCurrentDoc.DbConnect = DBCONNECTBASE Then
If IsEmpty(vFormNamesList) Then
Set oForms = vCurrentDoc.Document.getFormDocuments()
vFormNamesList = _CollectNames(oForms, "")
End If
vNamesList = Split(vFormNamesList(0), cstSeparator)
Else
Exit Function
End If
_GetAllHierarchicalNames = vNamesList
Set oForms = Nothing
End Function ' _GetAllHierarchicalNames V 6.2.0
REM -----------------------------------------------------------------------------------------------------------------------
Private Function _GetHierarchicalName(ByVal psPersistent As String) As String
' Return the full hierarchical name from the persistent name of a form/report
Dim vPersistentList As Variant, vNamesList As Variant, i As Integer
Const cstSeparator = "\;"
_GetHierarchicalName = ""
' Load complete list of names when Base document
vNamesList = _GetAllHierarchicalNames()
If UBound(vNamesList) < 0 Then Exit Function
vPersistentList = Split(vFormNamesList(1), cstSeparator)
' Search in list
For i = 0 To UBound(vPersistentList)
If vPersistentList(i) = psPersistent Then
_GetHierarchicalName = vNamesList(i)
Exit For
End If
Next i
End Function ' _GetHierarchicalName V 6.2.0
REM -----------------------------------------------------------------------------------------------------------------------
Private Function _NewBar() As Object
' Close current status bar, if any, and initialize new one
......
......@@ -125,7 +125,7 @@ Dim oDatabase As Object
' Check existence of object and find its exact (case-sensitive) name
Select Case pvObjectType
Case acForm
sObjects = oDatabase.Document.getFormDocuments.ElementNames()
sObjects = Application._GetAllHierarchicalNames()
lComponent = com.sun.star.sdb.application.DatabaseObject.FORM
Case acTable
sObjects = oDatabase.Connection.getTables.ElementNames()
......@@ -149,7 +149,7 @@ Dim oDatabase As Object
Select Case pvObjectType
Case acForm
Set oController = oDatabase.Document.getFormDocuments.getByName(sObjectName)
Set oController = oDatabase.Document.getFormDocuments.getByHierarchicalName(sObjectName)
mClose = oController.close()
Case acTable, acQuery ' Not optimal but it works !!
Set oController = oDatabase.Document.CurrentController
......@@ -1140,6 +1140,8 @@ Dim sFilter As String, oForm As Object, oFormsCollection As Object
Else
sFilter = "(" & pvFilterName & ") And (" & pvWhereCondition & ")"
End If
Set oFormsCollection = oOpenForm.DrawPage.Forms
If oFormsCollection.getCount() > 0 Then Set oForm = oFormsCollection.getByIndex(0) Else Set oForm = Nothing
If Not IsNull(oForm) Then
If sFilter <> "" Then
oForm.Filter = oDatabase._ReplaceSquareBrackets(sFilter)
......@@ -1174,7 +1176,7 @@ Dim sFilter As String, oForm As Object, oFormsCollection As Object
End If
.Visible = ( pvWindowMode <> acHidden )
._OpenArgs = pvOpenArgs
'To avoid AOO 3,4 bug See http://user.services.openoffice.org/en/forum/viewtopic.php?f=13&t=53751
'To avoid AOO 3.4 bug See http://user.services.openoffice.org/en/forum/viewtopic.php?f=13&t=53751
.Component.CurrentController.ViewSettings.ShowOnlineLayout = True
End With
......@@ -2355,6 +2357,7 @@ Dim oEnum As Object, oDesk As Object, oComp As Object, oFrame As Object, i As In
Dim bFound As Boolean, bActive As Boolean, sName As String, iType As Integer, sDocumentType As String
Dim sImplementation As String, vLocation() As Variant
Dim oWindow As _Window
Dim vPersistent As Variant, oForm As Object
If _ErrorHandler() Then On Local Error Goto Error_Function
......@@ -2402,7 +2405,10 @@ Dim oWindow As _Window
iType = acDocument
sDocumentType = docWriter
End Select
If iType = acForm Or iType = acReport Then ' Identify Form or Report name
If iType = acForm Then ' Identify persistent Form name
vPersistent = Split(oComp.StringValue, "/")
sName = _GetHierarchicalName(vPersistent(UBound(vPersistent) - 1))
ElseIf iType = acReport Then ' Identify Report name
For i = 0 To UBound(oComp.Args())
If oComp.Args(i).Name = "DocumentTitle" Then
sName = oComp.Args(i).Value
......
......@@ -248,6 +248,7 @@ Dim oObject As Object, i As Integer
Dim sShortcut As String, sAddShortcut As String, sArray() As String
Dim sImplementation As String, oSelection As Object
Dim iCurrentDoc As Integer, oDoc As Object
Dim vPersistent As Variant
Const cstDatabaseForm = "com.sun.star.comp.forms.ODatabaseForm"
If _ErrorHandler() Then On Local Error Goto Error_Function
......@@ -353,24 +354,18 @@ Const cstDatabaseForm = "com.sun.star.comp.forms.ODatabaseForm"
sImplementation = Utils._ImplementationName(oObject)
Loop
' Add Forms! prefix
' Select Case oDoc.DbConnect
' Case DBCONNECTBASE
If Utils._hasUNOProperty(oObject, "Args") Then ' Current object is a SwXTextDocument
For i = 0 To UBound(oObject.Args)
If oObject.Args(i).Name = "DocumentTitle" Then
sAddShortcut = Utils._Surround(oObject.Args(i).Value)
Exit For
End If
Next i
End If
Select Case oDoc.DbConnect
Case DBCONNECTBASE
vPersistent = Split(oObject.StringValue, "/")
sAddShortcut = Utils._Surround(_GetHierarchicalName(vPersistent(UBound(vPersistent) - 1)))
sShortcut = "Forms!" & sAddShortcut & "!" & sShortcut
' Case DBCONNECTFORM
' sShortcut = "Forms!0!" & sShortcut
' End Select
Case DBCONNECTFORM
sShortcut = "Forms!0!" & sShortcut
End Select
sArray = Split(sShortcut, "!")
' If presence of "Forms!myform!myform.Form", eliminate 2nd element
' Eliminate anyway blanco subcomponents (e.g; Forms!!myForm)
' Eliminate anyway blanco subcomponents (e.g. Forms!!myForm)
If UBound(sArray) >= 2 Then
If UCase(sArray(1)) & ".FORM" = UCase(sArray(2)) Then sArray(1) = ""
sArray = Utils._TrimArray(sArray)
......
......@@ -21,6 +21,7 @@ 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
......@@ -39,6 +40,7 @@ Private Sub Class_Initialize()
_DocEntry = -1
_DbEntry = -1
_MainForms = Array()
_PersistentName = ""
_IsLoaded = False
_OpenArgs = ""
_OrderBy = ""
......@@ -160,29 +162,24 @@ Function IsLoaded(ByVal Optional pbForce As Boolean) As Boolean
End If
IsLoaded = False
Dim oDoc As Object, oDatabase As Object, oEnum As Object, oDesk As Object, oComp As Object, bFound As Boolean
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
bFound = False
Do While oEnum.hasMoreElements And Not bFound ' Search in all open components if one corresponds with current form
Do While oEnum.hasMoreElements ' Search in all open components if one corresponds with current form
oComp = oEnum.nextElement
If HasUnoInterfaces(oComp, "com.sun.star.frame.XModule") Then
If _hasUNOProperty(oComp, "Identifier") Then
If oComp.Identifier = "com.sun.star.sdb.FormDesign" Then
For i = 0 To UBound(oComp.Args())
If oComp.Args(i).Name = "DocumentTitle" Then
bFound = ( oComp.Args(i).Value = _Name )
If bFound Then
vPersistent = Split(oComp.StringValue, "/")
If vPersistent(UBound(vPersistent) - 1) = _PersistentName Then
_IsLoaded = True
Set Component = oComp
Exit For
Exit Do
End If
End If
Next i
End If
End If
Loop
Case DBCONNECTFORM
......@@ -230,6 +227,7 @@ End Property ' OnApproveParameter (get)
Property Let OnApproveParameter(ByVal pvValue As Variant)
Call _PropertySet("OnApproveParameter", pvValue)
End Property ' OnApproveParameter (set)
REM -----------------------------------------------------------------------------------------------------------------------
......@@ -464,7 +462,7 @@ Dim oDatabase As Object, oController As Object
Set oDatabase = Application._CurrentDb()
If oDatabase._DbConnect <> DBCONNECTBASE Then Goto Error_NotApplicable
Set oController = oDatabase.Document.getFormDocuments.getByName(_Name)
Set oController = oDatabase.Document.getFormDocuments.getByHierarchicalName(_Name)
oController.close()
Dispose()
mClose = True
......@@ -478,7 +476,7 @@ Error_NotApplicable:
Error_Function:
TraceError(TRACEABORT, Err, "Form.Close", Erl)
GoTo Exit_Function
End Function
End Function ' Close
REM -----------------------------------------------------------------------------------------------------------------------
Public Function Controls(Optional ByVal pvIndex As Variant) As Variant
......@@ -806,8 +804,9 @@ Dim oDoc As Object, oDatabase As Object
If _ErrorHandler() Then On Local Error Goto Trace_Error
_Name = psName
_Shortcut = "Forms!" & Utils._Surround(psName)
If IsLoaded Then
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
......@@ -856,7 +855,7 @@ End Sub ' _Initialize V1.1.0
REM -----------------------------------------------------------------------------------------------------------------------
Private Function _PropertiesList() As Variant
If IsLoaded Then
If _IsLoaded Then
_PropertiesList = Array("AllowAdditions", "AllowDeletions", "AllowEdits", "Bookmark" _
, "Caption", "CurrentRecord", "Filter", "FilterOn", "Height", "IsLoaded" _
, "Name", "ObjectType", "OnApproveCursorMove", "OnApproveParameter" _
......
......@@ -448,7 +448,7 @@ Dim oDoc As Object
Case OBJCOLLECTION
Select Case vCurrentObject._CollType
Case COLLFORMS
vCurrentObject = Application.Forms(sComponents(iCurrentIndex))
vCurrentObject = Application.AllForms(sComponents(iCurrentIndex))
Case COLLALLDIALOGS
sDialog = UCase(sComponents(iCurrentIndex))
vCurrentObject = Application.AllDialogs(sDialog)
......
......@@ -105,9 +105,9 @@ Dim vDbContainer As Variant, vDbContainers() As Variant, vDocContainer As Varian
iCurrentDoc = CurrentDocIndex( , False) ' False prevents error raising if not found
If iCurrentDoc < 0 Then GoTo Exit_Sub ' If not found ignore
vDocContainer = CurrentDoc(iCurrentDoc)
vDocContainer = CurrentDocument(iCurrentDoc)
With vDocContainer
If Not .Active Then GoTo Exit_Sub ' e.g. if successive calls to CloseConnection()
If Not .Active Then GoTo Exit_Sub ' e.g. if multiple calls to CloseConnection()
For i = 0 To UBound(.DbContainers)
If Not IsNull(.DbContainers(i).Database) Then
.DbContainers(i).Database.Dispose()
......
......@@ -726,6 +726,7 @@ Dim bIsPseudo As Boolean, bPseudoExists As Boolean, vObject As Variant
If Not bIsPseudo Then Goto Exit_Function
Dim oDoc As Object, oForms As Variant
Const cstSeparator = "\;"
bPseudoExists = False
With vObject
......@@ -733,12 +734,7 @@ Dim oDoc As Object, oForms As Variant
Case OBJFORM
If ._Name <> "" Then ' Check validity of form name
Set oDoc = _A2B_.CurrentDocument()
If oDoc.DbConnect = DBCONNECTFORM Then
bPseudoExists = True
Else
Set oForms = oDoc.Document.getFormDocuments()
bPseudoExists = ( oForms.HasByName(._Name) )
End If
If oDoc.DbConnect = DBCONNECTFORM Then bPseudoExists = True Else bPseudoExists = _InList(._Name, Application._GetAllHierarchicalNames())
End If
Case OBJDATABASE
If ._DbConnect = DBCONNECTFORM Then bPseudoExists = True Else bPseudoExists = Not IsNull(.Connection)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment