mirror of
https://gitee.com/kekingcn/file-online-preview.git
synced 2026-05-09 08:24:02 +00:00
集成OpenOffice替换为LibreOffice
This commit is contained in:
陈精华
1869
office-plugin/windows-office/share/basic/Access2Base/Application.xba
Normal file
1869
office-plugin/windows-office/share/basic/Access2Base/Application.xba
Normal file
File diff suppressed because it is too large
Load Diff
399
office-plugin/windows-office/share/basic/Access2Base/Collect.xba
Normal file
399
office-plugin/windows-office/share/basic/Access2Base/Collect.xba
Normal file
@@ -0,0 +1,399 @@
|
||||
<?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="Collect" 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 MODULE NAME <> COLLECTION (is a reserved name for ... collections)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS ROOT FIELDS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
Private _Type As String ' Must be COLLECTION
|
||||
Private _This As Object ' Workaround for absence of This builtin function
|
||||
Private _CollType As String
|
||||
Private _Parent As Object
|
||||
Private _Count As Long
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CONSTRUCTORS / DESTRUCTORS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Sub Class_Initialize()
|
||||
_Type = OBJCOLLECTION
|
||||
Set _This = Nothing
|
||||
_CollType = ""
|
||||
Set _Parent = Nothing
|
||||
_Count = 0
|
||||
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 Count() As Long
|
||||
Count = _PropertyGet("Count")
|
||||
End Property ' Count (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Function Item(ByVal Optional pvItem As Variant) As Variant
|
||||
'Return property value.
|
||||
'pvItem either numeric index or property name
|
||||
|
||||
Const cstThisSub = "Collection.getItem"
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
If IsMissing(pvItem) Then Goto Exit_Function ' To allow object watching in Basic IDE, do not generate error
|
||||
Select Case _CollType
|
||||
Case COLLCOMMANDBARCONTROLS ' Have no name
|
||||
If Not Utils._CheckArgument(pvItem, 1, Utils._AddNumeric()) Then Goto Exit_Function
|
||||
Case Else
|
||||
If Not Utils._CheckArgument(pvItem, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function
|
||||
End Select
|
||||
|
||||
Dim vNames() As Variant, oProperty As Object
|
||||
|
||||
Set Item = Nothing
|
||||
Select Case _CollType
|
||||
Case COLLALLDIALOGS
|
||||
Set Item = Application.AllDialogs(pvItem)
|
||||
Case COLLALLFORMS
|
||||
Set Item = Application.AllForms(pvItem)
|
||||
Case COLLALLMODULES
|
||||
Set Item = Application.AllModules(pvItem)
|
||||
Case COLLCOMMANDBARS
|
||||
Set Item = Application.CommandBars(pvItem)
|
||||
Case COLLCOMMANDBARCONTROLS
|
||||
If IsNull(_Parent) Then GoTo Error_Parent
|
||||
Set Item = _Parent.CommandBarControls(pvItem)
|
||||
Case COLLCONTROLS
|
||||
If IsNull(_Parent) Then GoTo Error_Parent
|
||||
Set Item = _Parent.Controls(pvItem)
|
||||
Case COLLFORMS
|
||||
Set Item = Application.Forms(pvItem)
|
||||
Case COLLFIELDS
|
||||
If IsNull(_Parent) Then GoTo Error_Parent
|
||||
Set Item = _Parent.Fields(pvItem)
|
||||
Case COLLPROPERTIES
|
||||
If IsNull(_Parent) Then GoTo Error_Parent
|
||||
Select Case _Parent._Type
|
||||
Case OBJCONTROL, OBJSUBFORM, OBJDATABASE, OBJDIALOG, OBJFIELD _
|
||||
, OBJFORM, OBJQUERYDEF, OBJRECORDSET, OBJTABLEDEF
|
||||
Set Item = _Parent.Properties(pvItem)
|
||||
Case OBJCOLLECTION, OBJEVENT, OBJOPTIONGROUP, OBJPROPERTY
|
||||
' NOT SUPPORTED
|
||||
End Select
|
||||
Case COLLQUERYDEFS
|
||||
Set Item = _Parent.QueryDefs(pvItem)
|
||||
Case COLLRECORDSETS
|
||||
Set Item = _Parent.Recordsets(pvItem)
|
||||
Case COLLTABLEDEFS
|
||||
Set Item = _Parent.TableDefs(pvItem)
|
||||
Case COLLTEMPVARS
|
||||
Set Item = Application.TempVars(pvItem)
|
||||
Case Else
|
||||
End Select
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, Utils._CalledSub(), Erl)
|
||||
Set Item = Nothing
|
||||
GoTo Exit_Function
|
||||
Error_Parent:
|
||||
TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, True, Array(_GetLabel("OBJECT"), _GetLabel("PARENT")))
|
||||
Set Item = Nothing
|
||||
GoTo Exit_Function
|
||||
End Function ' Item V1.1.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get ObjectType() As String
|
||||
ObjectType = _PropertyGet("ObjectType")
|
||||
End Property ' ObjectType (get)
|
||||
|
||||
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 -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS METHODS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
Public Function Add(Optional pvNew As Variant, Optional pvValue As Variant) As Boolean
|
||||
' Append a new TableDef or TempVar object to the TableDefs/TempVars collections
|
||||
|
||||
Const cstThisSub = "Collection.Add"
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
|
||||
Dim odbDatabase As Object, oConnection As Object, oTables As Object, oTable As Object
|
||||
Dim vObject As Variant, oTempVar As Object
|
||||
Add = False
|
||||
If IsMissing(pvNew) Then Call _TraceArguments()
|
||||
|
||||
Select Case _CollType
|
||||
Case COLLTABLEDEFS
|
||||
If Not Utils._CheckArgument(pvNew, 1, vbObject) Then Goto Exit_Function
|
||||
Set vObject = pvNew
|
||||
With vObject
|
||||
Set odbDatabase = ._ParentDatabase
|
||||
If odbDatabase._DbConnect <> DBCONNECTBASE Then Goto Error_NotApplicable
|
||||
Set oConnection = odbDatabase.Connection
|
||||
If IsNull(.TableDescriptor) Or .TableFieldsCount = 0 Then Goto Error_Sequence
|
||||
Set oTables = oConnection.getTables()
|
||||
oTables.appendByDescriptor(.TableDescriptor)
|
||||
Set .Table = oTables.getByName(._Name)
|
||||
.CatalogName = .Table.CatalogName
|
||||
.SchemaName = .Table.SchemaName
|
||||
.TableName = .Table.Name
|
||||
.TableDescriptor.dispose()
|
||||
Set .TableDescriptor = Nothing
|
||||
.TableFieldsCount = 0
|
||||
.TableKeysCount = 0
|
||||
End With
|
||||
Case COLLTEMPVARS
|
||||
If Not Utils._CheckArgument(pvNew, 1, vbString) Then Goto Exit_Function
|
||||
If pvNew = "" Then Goto Error_Name
|
||||
If IsMissing(pvValue) Then Call _TraceArguments()
|
||||
If _A2B_.hasItem(COLLTEMPVARS, pvNew) Then Goto Error_Name
|
||||
Set oTempVar = New TempVar
|
||||
oTempVar._This = oTempVar
|
||||
oTempVar._Name = pvNew
|
||||
oTempVar._Value = pvValue
|
||||
_A2B_.TempVars.Add(oTempVar, UCase(pvNew))
|
||||
Case Else
|
||||
Goto Error_NotApplicable
|
||||
End Select
|
||||
|
||||
_Count = _Count + 1
|
||||
Add = True
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, cstThisSub, Erl)
|
||||
GoTo Exit_Function
|
||||
Error_NotApplicable:
|
||||
TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub)
|
||||
Goto Exit_Function
|
||||
Error_Sequence:
|
||||
TraceError(TRACEFATAL, ERRTABLECREATION, Utils._CalledSub(), 0, 1, vObject._Name)
|
||||
Goto Exit_Function
|
||||
Error_Name:
|
||||
TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), False, ,Array(1, pvNew))
|
||||
AddItem = False
|
||||
Goto Exit_Function
|
||||
End Function ' Add V1.1.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Delete(ByVal Optional pvName As Variant) As Boolean
|
||||
' Delete a TableDef or QueryDef object in the TableDefs/QueryDefs collections
|
||||
|
||||
Const cstThisSub = "Collection.Delete"
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
|
||||
Dim odbDatabase As Object, oColl As Object, vName As Variant
|
||||
Delete = False
|
||||
If IsMissing(pvName) Then pvName = ""
|
||||
If Not Utils._CheckArgument(pvName, 1, vbString) Then Goto Exit_Function
|
||||
If pvName = "" Then Call _TraceArguments()
|
||||
|
||||
Select Case _CollType
|
||||
Case COLLTABLEDEFS, COLLQUERYDEFS
|
||||
If _A2B_.CurrentDocIndex() <> 0 Then Goto Error_NotApplicable
|
||||
Set odbDatabase = Application._CurrentDb()
|
||||
If odbDatabase._DbConnect <> DBCONNECTBASE Then Goto Error_NotApplicable
|
||||
If _CollType = COLLTABLEDEFS Then Set oColl = odbDatabase.Connection.getTables() Else Set oColl = odbDatabase.Connection.getQueries()
|
||||
With oColl
|
||||
vName = _InList(pvName, .getElementNames(), True)
|
||||
If vName = False Then Goto trace_NotFound
|
||||
.dropByName(vName)
|
||||
End With
|
||||
odbDatabase.Document.store()
|
||||
Case Else
|
||||
Goto Error_NotApplicable
|
||||
End Select
|
||||
|
||||
_Count = _Count - 1
|
||||
Delete = True
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, cstThisSub, Erl)
|
||||
GoTo Exit_Function
|
||||
Error_NotApplicable:
|
||||
TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub)
|
||||
Goto Exit_Function
|
||||
Trace_NotFound:
|
||||
TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel(Left(_CollType, 5)), pvName))
|
||||
Goto Exit_Function
|
||||
End Function ' Delete V1.1.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
|
||||
' Return property value of psProperty property name
|
||||
|
||||
Utils._SetCalledSub("Collection.getProperty")
|
||||
If IsMissing(pvProperty) Then Call _TraceArguments()
|
||||
getProperty = _PropertyGet(pvProperty)
|
||||
Utils._ResetCalledSub("Collection.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 Remove(ByVal Optional pvName As Variant) As Boolean
|
||||
' Remove a TempVar from the TempVars collection
|
||||
|
||||
Const cstThisSub = "Collection.Remove"
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
|
||||
Dim oColl As Object, vName As Variant
|
||||
Remove = False
|
||||
If IsMissing(pvName) Then pvName = ""
|
||||
If Not Utils._CheckArgument(pvName, 1, vbString) Then Goto Exit_Function
|
||||
If pvName = "" Then Call _TraceArguments()
|
||||
|
||||
Select Case _CollType
|
||||
Case COLLTEMPVARS
|
||||
If Not _A2B_.hasItem(COLLTEMPVARS, pvName) Then Goto Error_Name
|
||||
_A2B_.TempVars.Remove(UCase(pvName))
|
||||
Case Else
|
||||
Goto Error_NotApplicable
|
||||
End Select
|
||||
|
||||
_Count = _Count - 1
|
||||
Remove = True
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, cstThisSub, Erl)
|
||||
GoTo Exit_Function
|
||||
Error_NotApplicable:
|
||||
TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub)
|
||||
Goto Exit_Function
|
||||
Error_Name:
|
||||
TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), False, ,Array(1, pvName))
|
||||
AddItem = False
|
||||
Goto Exit_Function
|
||||
End Function ' Remove V1.2.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function RemoveAll() As Boolean
|
||||
' Remove the whole TempVars collection
|
||||
|
||||
Const cstThisSub = "Collection.Remove"
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
|
||||
Select Case _CollType
|
||||
Case COLLTEMPVARS
|
||||
Set _A2B_.TempVars = New Collection
|
||||
_Count = 0
|
||||
Case Else
|
||||
Goto Error_NotApplicable
|
||||
End Select
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, cstThisSub, Erl)
|
||||
GoTo Exit_Function
|
||||
Error_NotApplicable:
|
||||
TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub)
|
||||
Goto Exit_Function
|
||||
End Function ' RemoveAll V1.2.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- PRIVATE FUNCTIONS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _PropertiesList() As Variant
|
||||
_PropertiesList = Array("Count", "Item", "ObjectType")
|
||||
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("Collection.get" & psProperty)
|
||||
_PropertyGet = Nothing
|
||||
|
||||
Select Case UCase(psProperty)
|
||||
Case UCase("Count")
|
||||
_PropertyGet = _Count
|
||||
Case UCase("Item")
|
||||
Case UCase("ObjectType")
|
||||
_PropertyGet = _Type
|
||||
Case Else
|
||||
Goto Trace_Error
|
||||
End Select
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub("Collection.get" & psProperty)
|
||||
Exit Function
|
||||
Trace_Error:
|
||||
TraceError(TRACEWARNING, ERRPROPERTY, Utils._CalledSub(), 0, , psProperty)
|
||||
_PropertyGet = Nothing
|
||||
Goto Exit_Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, "Collection._PropertyGet", Erl)
|
||||
_PropertyGet = Nothing
|
||||
GoTo Exit_Function
|
||||
End Function ' _PropertyGet
|
||||
|
||||
</script:module>
|
||||
@@ -0,0 +1,396 @@
|
||||
<?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="CommandBar" 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 COMMANDBAR
|
||||
Private _This As Object ' Workaround for absence of This builtin function
|
||||
Private _Parent As Object
|
||||
Private _Name As String
|
||||
Private _ResourceURL As String
|
||||
Private _Window As Object ' com.sun.star.frame.XFrame
|
||||
Private _Module As String
|
||||
Private _Toolbar As Object
|
||||
Private _BarBuiltin As Integer ' 1 = builtin, 2 = custom stored in LO/AOO (Base), 3 = custom stored in document (Form)
|
||||
Private _BarType As Integer ' See msoBarTypeXxx constants
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CONSTRUCTORS / DESTRUCTORS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Sub Class_Initialize()
|
||||
_Type = OBJCOMMANDBAR
|
||||
Set _This = Nothing
|
||||
Set _Parent = Nothing
|
||||
_Name = ""
|
||||
_ResourceURL = ""
|
||||
Set _Window = Nothing
|
||||
_Module = ""
|
||||
Set _Toolbar = Nothing
|
||||
_BarBuiltin = 0
|
||||
_BarType = -1
|
||||
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 -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get BuiltIn() As Boolean
|
||||
BuiltIn = _PropertyGet("BuiltIn")
|
||||
End Property ' BuiltIn (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 -----------------------------------------------------------------------------------------------------------------------
|
||||
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 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 -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS METHODS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function CommandBarControls(Optional ByVal pvIndex As Variant) As Variant
|
||||
' Return an object of type CommandBarControl indicated by its index
|
||||
' Index is different from UNO index: separators do not count
|
||||
' If no pvIndex argument, return a Collection type
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
Const cstThisSub = "CommandBar.CommandBarControls"
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
|
||||
Dim oLayout As Object, vElements() As Variant, iIndexToolbar As Integer, oToolbar As Object
|
||||
Dim i As Integer, iItemsCount As Integer, oSettings As Object, vItem() As Variant, bSeparator As Boolean
|
||||
Dim oObject As Object
|
||||
|
||||
Set oObject = Nothing
|
||||
If Not IsMissing(pvIndex) Then
|
||||
If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric()) Then Goto Exit_Function
|
||||
If pvIndex < 0 Then Goto Trace_IndexError
|
||||
End If
|
||||
|
||||
Select Case _BarType
|
||||
Case msoBarTypeNormal, msoBarTypeMenuBar
|
||||
Case Else : Goto Error_NotApplicable ' Status bar not supported
|
||||
End Select
|
||||
|
||||
Set oLayout = _Window.LayoutManager
|
||||
vElements = oLayout.getElements()
|
||||
iIndexToolbar = _FindElement(vElements())
|
||||
If iIndexToolbar < 0 Then Goto Error_NotApplicable ' Toolbar not visible
|
||||
Set oToolbar = vElements(iIndexToolbar)
|
||||
|
||||
iItemsCount = 0
|
||||
Set oSettings = oToolbar.getSettings(False)
|
||||
|
||||
bSeparator = False
|
||||
For i = 0 To oSettings.getCount() - 1
|
||||
Set vItem() = oSettings.getByIndex(i)
|
||||
If _GetPropertyValue(vItem, "Type", 1) <> 1 Then ' Type = 1 indicates separator
|
||||
iItemsCount = iItemsCount + 1
|
||||
If Not IsMissing(pvIndex) Then
|
||||
If pvIndex = iItemsCount - 1 Then
|
||||
Set oObject = New CommandBarControl
|
||||
With oObject
|
||||
Set ._This = oObject
|
||||
Set ._Parent = _This
|
||||
._ParentCommandBarName = _Name
|
||||
._ParentCommandBar = oToolbar
|
||||
._ParentBuiltin = ( _BarBuiltin = 1 )
|
||||
._Element = vItem()
|
||||
._InternalIndex = i
|
||||
._Index = iItemsCount ' Indexes start at 1
|
||||
._BeginGroup = bSeparator
|
||||
End With
|
||||
End If
|
||||
bSeparator = False
|
||||
End If
|
||||
Else
|
||||
bSeparator = True
|
||||
End If
|
||||
Next i
|
||||
|
||||
If IsNull(oObject) Then
|
||||
Select Case True
|
||||
Case IsMissing(pvIndex)
|
||||
Set oObject = New Collect
|
||||
Set oObject._This = oObject
|
||||
oObject._CollType = COLLCOMMANDBARCONTROLS
|
||||
Set oObject._Parent = _This
|
||||
oObject._Count = iItemsCount
|
||||
Case Else ' pvIndex is numeric
|
||||
Goto Trace_IndexError
|
||||
End Select
|
||||
End If
|
||||
|
||||
Exit_Function:
|
||||
Set CommandBarControls = oObject
|
||||
Set oObject = Nothing
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, cstThisSub, Erl)
|
||||
GoTo Exit_Function
|
||||
Trace_IndexError:
|
||||
TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0)
|
||||
Goto Exit_Function
|
||||
Error_NotApplicable:
|
||||
TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub)
|
||||
Goto Exit_Function
|
||||
End Function ' CommandBarControls V1,3,0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Controls(Optional ByVal pvIndex As Variant) As Variant
|
||||
' Alias for CommandBarControls (VBA)
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
Const cstThisSub = "CommandBar.Controls"
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
|
||||
Dim oObject As Object
|
||||
|
||||
If IsMissing(pvIndex) Then Set oObject = CommandBarControls() Else Set oObject = CommandBarControls(pvIndex)
|
||||
|
||||
Exit_Function:
|
||||
Set Controls = oObject
|
||||
Set oObject = Nothing
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, cstThisSub, Erl)
|
||||
GoTo Exit_Function
|
||||
End Function ' Controls V1,3,0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
|
||||
' Return property value of psProperty property name
|
||||
|
||||
Utils._SetCalledSub("CommandBar.getProperty")
|
||||
If IsMissing(pvProperty) Then Call _TraceArguments()
|
||||
getProperty = _PropertyGet(pvProperty)
|
||||
Utils._ResetCalledSub("CommandBar.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 Reset() As Boolean
|
||||
' Reset a whole command bar to its initial values
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
Const cstThisSub = "CommandBar.Reset"
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
|
||||
_Toolbar.reload()
|
||||
|
||||
Exit_Function:
|
||||
Reset = True
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, cstThisSub, Erl)
|
||||
Reset = False
|
||||
GoTo Exit_Function
|
||||
End Function ' Reset V1.3.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- PRIVATE FUNCTIONS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _FindElement(pvElements As Variant) As Integer
|
||||
' Return -1 if not found, otherwise return index in elements table of LayoutManager
|
||||
|
||||
Dim i As Integer
|
||||
|
||||
_FindElement = -1
|
||||
If Not IsArray(pvElements) Then Exit Function
|
||||
|
||||
For i = 0 To UBound(pvElements)
|
||||
If _ResourceURL = pvElements(i).ResourceURL Then
|
||||
_FindElement = i
|
||||
Exit Function
|
||||
End If
|
||||
Next i
|
||||
|
||||
End Function
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _PropertiesList() As Variant
|
||||
_PropertiesList = Array("BuiltIn", "Name", "ObjectType", "Visible")
|
||||
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
|
||||
Dim cstThisSub As String
|
||||
cstThisSub = "CommandBar.get" & psProperty
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
_PropertyGet = Nothing
|
||||
|
||||
Dim oLayout As Object, iElementIndex As Integer
|
||||
|
||||
Select Case UCase(psProperty)
|
||||
Case UCase("BuiltIn")
|
||||
_PropertyGet = ( _BarBuiltin = 1 )
|
||||
Case UCase("Name")
|
||||
_PropertyGet = _Name
|
||||
Case UCase("ObjectType")
|
||||
_PropertyGet = _Type
|
||||
Case UCase("Visible")
|
||||
Set oLayout = _Window.LayoutManager
|
||||
iElementIndex = _FindElement(oLayout.getElements())
|
||||
If iElementIndex < 0 Then _PropertyGet = False Else _PropertyGet = oLayout.isElementVisible(_ResourceURL)
|
||||
Case Else
|
||||
Goto Trace_Error
|
||||
End Select
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
Trace_Error:
|
||||
TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty)
|
||||
_PropertyGet = Nothing
|
||||
Goto Exit_Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, Utils._CalledSub(), Erl)
|
||||
_PropertyGet = Nothing
|
||||
GoTo Exit_Function
|
||||
End Function ' _PropertyGet
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Variant) As Boolean
|
||||
' Return True if property setting OK
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
Dim cstThisSub As String
|
||||
cstThisSub = "CommandBar.set" & psProperty
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
_PropertySet = True
|
||||
Dim iArgNr As Integer
|
||||
Dim oLayout As Object, iElementIndex As Integer
|
||||
|
||||
|
||||
Select Case UCase(_A2B_.CalledSub)
|
||||
Case UCase("setProperty") : iArgNr = 3
|
||||
Case UCase("CommandBar.setProperty") : iArgNr = 2
|
||||
Case UCase(cstThisSub) : iArgNr = 1
|
||||
End Select
|
||||
|
||||
If Not hasProperty(psProperty) Then Goto Trace_Error
|
||||
|
||||
Select Case UCase(psProperty)
|
||||
Case UCase("Visible")
|
||||
If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value
|
||||
Set oLayout = _Window.LayoutManager
|
||||
With oLayout
|
||||
iElementIndex = _FindElement(.getElements())
|
||||
If iElementIndex < 0 Then
|
||||
If pvValue Then
|
||||
.createElement(_ResourceURL)
|
||||
.showElement(_ResourceURL)
|
||||
End If
|
||||
Else
|
||||
If pvValue <> .isElementVisible(_ResourceURL) Then
|
||||
If pvValue Then .showElement(_ResourceURL) Else .hideElement(_ResourceURL)
|
||||
End If
|
||||
End If
|
||||
End With
|
||||
Case Else
|
||||
Goto Trace_Error
|
||||
End Select
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
Trace_Error:
|
||||
TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, , 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, cstThisSub, Erl)
|
||||
_PropertySet = False
|
||||
GoTo Exit_Function
|
||||
End Function ' _PropertySet
|
||||
|
||||
</script:module>
|
||||
@@ -0,0 +1,339 @@
|
||||
<?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="CommandBarControl" 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 COMMANDBARCONTROL
|
||||
Private _This As Object ' Workaround for absence of This builtin function
|
||||
Private _Parent As Object
|
||||
Private _InternalIndex As Integer ' Index in toolbar including separators
|
||||
Private _Index As Integer ' Index in collection, starting at 1 !!
|
||||
Private _ControlType As Integer ' 1 of the msoControl* constants
|
||||
Private _ParentCommandBarName As String
|
||||
Private _ParentCommandBar As Object ' com.sun.star.ui.XUIElement
|
||||
Private _ParentBuiltin As Boolean
|
||||
Private _Element As Variant
|
||||
Private _BeginGroup As Boolean
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CONSTRUCTORS / DESTRUCTORS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Sub Class_Initialize()
|
||||
_Type = OBJCOMMANDBARCONTROL
|
||||
Set _This = Nothing
|
||||
Set _Parent = Nothing
|
||||
_Index = -1
|
||||
_ParentCommandBarName = ""
|
||||
Set _ParentCommandBar = Nothing
|
||||
_ParentBuiltin = False
|
||||
_Element = Array()
|
||||
_BeginGroup = False
|
||||
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 -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get BeginGroup() As Boolean
|
||||
BeginGroup = _PropertyGet("BeginGroup")
|
||||
End Property ' BeginGroup (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get BuiltIn() As Boolean
|
||||
BuiltIn = _PropertyGet("BuiltIn")
|
||||
End Property ' BuiltIn (get)
|
||||
|
||||
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 Index() As Integer
|
||||
Index = _PropertyGet("Index")
|
||||
End Property ' Index (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get ObjectType() As String
|
||||
ObjectType = _PropertyGet("ObjectType")
|
||||
End Property ' ObjectType (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get OnAction() As Variant
|
||||
OnAction = _PropertyGet("OnAction")
|
||||
End Property ' OnAction (get)
|
||||
|
||||
Property Let OnAction(ByVal pvValue As Variant)
|
||||
Call _PropertySet("OnAction", pvValue)
|
||||
End Property ' OnAction (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get Parent() As Object
|
||||
Parent = _PropertyGet("Parent")
|
||||
End Property ' Parent (get)
|
||||
|
||||
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 TooltipText() As Variant
|
||||
TooltipText = _PropertyGet("TooltipText")
|
||||
End Property ' TooltipText (get)
|
||||
|
||||
Property Let TooltipText(ByVal pvValue As Variant)
|
||||
Call _PropertySet("TooltipText", pvValue)
|
||||
End Property ' TooltipText (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function pType() As Integer
|
||||
pType = _PropertyGet("Type")
|
||||
End Function ' Type (get)
|
||||
|
||||
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 -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS METHODS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Execute()
|
||||
' Execute the command stored in a toolbar button
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
Const cstThisSub = "CommandBarControl.Execute"
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
|
||||
Dim sExecute As String
|
||||
|
||||
Execute = True
|
||||
sExecute = _GetPropertyValue(_Element, "CommandURL", "")
|
||||
|
||||
Select Case True
|
||||
Case sExecute = "" : Execute = False
|
||||
Case _IsLeft(sExecute, ".uno:")
|
||||
Execute = DoCmd.RunCommand(sExecute)
|
||||
Case _IsLeft(sExecute, "vnd.sun.star.script:")
|
||||
Execute = Utils._RunScript(sExecute, Array(Nothing))
|
||||
Case Else
|
||||
End Select
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, cstThisSub, Erl)
|
||||
Execute = False
|
||||
GoTo Exit_Function
|
||||
End Function ' Execute V1.3.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
|
||||
' Return property value of psProperty property name
|
||||
|
||||
Utils._SetCalledSub("CommandBarControl.getProperty")
|
||||
If IsMissing(pvProperty) Then Call _TraceArguments()
|
||||
getProperty = _PropertyGet(pvProperty)
|
||||
Utils._ResetCalledSub("CommandBar.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 -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- PRIVATE FUNCTIONS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _PropertiesList() As Variant
|
||||
_PropertiesList = Array("BeginGroup", "BuiltIn", "Caption", "Index" _
|
||||
, "ObjectType", "OnAction", "Parent" _
|
||||
, "TooltipText", "Type", "Visible" _
|
||||
)
|
||||
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
|
||||
Dim cstThisSub As String
|
||||
cstThisSub = "CommandBarControl.get" & psProperty
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
_PropertyGet = Null
|
||||
|
||||
Dim oLayout As Object, iElementIndex As Integer
|
||||
Dim sValue As String
|
||||
Const cstUnoPrefix = ".uno:"
|
||||
|
||||
Select Case UCase(psProperty)
|
||||
Case UCase("BeginGroup")
|
||||
_PropertyGet = _BeginGroup
|
||||
Case UCase("BuiltIn")
|
||||
sValue = _GetPropertyValue(_Element, "CommandURL", "")
|
||||
_PropertyGet = ( _IsLeft(sValue, cstUnoPrefix) )
|
||||
Case UCase("Caption")
|
||||
_PropertyGet = _GetPropertyValue(_Element, "Label", "")
|
||||
Case UCase("Index")
|
||||
_PropertyGet = _Index
|
||||
Case UCase("ObjectType")
|
||||
_PropertyGet = _Type
|
||||
Case UCase("OnAction")
|
||||
_PropertyGet = _GetPropertyValue(_Element, "CommandURL", "")
|
||||
Case UCase("Parent")
|
||||
Set _PropertyGet = _Parent
|
||||
Case UCase("TooltipText")
|
||||
sValue = _GetPropertyValue(_Element, "Tooltip", "")
|
||||
If sValue <> "" Then _PropertyGet = sValue Else _PropertyGet = _GetPropertyValue(_Element, "Label", "")
|
||||
Case UCase("Type")
|
||||
_PropertyGet = msoControlButton
|
||||
Case UCase("Visible")
|
||||
_PropertyGet = _GetPropertyValue(_Element, "IsVisible", "")
|
||||
Case Else
|
||||
Goto Trace_Error
|
||||
End Select
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
Trace_Error:
|
||||
TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty)
|
||||
_PropertyGet = Nothing
|
||||
Goto Exit_Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, Utils._CalledSub(), Erl)
|
||||
_PropertyGet = Nothing
|
||||
GoTo Exit_Function
|
||||
End Function ' _PropertyGet
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Variant) As Boolean
|
||||
' Return True if property setting OK
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
Dim cstThisSub As String
|
||||
cstThisSub = "CommandBarControl.set" & psProperty
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
_PropertySet = True
|
||||
Dim iArgNr As Integer
|
||||
Dim oSettings As Object, sValue As String
|
||||
|
||||
|
||||
Select Case UCase(_A2B_.CalledSub)
|
||||
Case UCase("setProperty") : iArgNr = 3
|
||||
Case UCase("CommandBar.setProperty") : iArgNr = 2
|
||||
Case UCase(cstThisSub) : iArgNr = 1
|
||||
End Select
|
||||
|
||||
If Not hasProperty(psProperty) Then Goto Trace_Error
|
||||
If _ParentBuiltin Then Goto Trace_Error ' Modifications of individual controls forbidden for builtin toolbars (design choice)
|
||||
|
||||
Const cstUnoPrefix = ".uno:"
|
||||
Const cstScript = "vnd.sun.star.script:"
|
||||
|
||||
Set oSettings = _ParentCommandBar.getSettings(True)
|
||||
Select Case UCase(psProperty)
|
||||
Case UCase("OnAction")
|
||||
If Not Utils._CheckArgument(pvValue, iArgNr, _AddNumeric(vbString), , False) Then Goto Trace_Error_Value
|
||||
Select Case VarType(pvValue)
|
||||
Case vbString
|
||||
If _IsLeft(pvValue, cstUnoPrefix) Then
|
||||
sValue = pvValue
|
||||
ElseIf _IsLeft(pvValue, cstScript) Then
|
||||
sValue = pvValue
|
||||
Else
|
||||
sValue = DoCmd.RunCommand(pvValue, True)
|
||||
End If
|
||||
Case Else ' Numeric
|
||||
sValue = DoCmd.RunCommand(pvValue, True)
|
||||
End Select
|
||||
_SetPropertyValue(_Element, "CommandURL", sValue)
|
||||
Case UCase("TooltipText")
|
||||
If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
|
||||
_SetPropertyValue(_Element, "Tooltip", pvValue)
|
||||
Case UCase("Visible")
|
||||
If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value
|
||||
_SetPropertyValue(_Element, "IsVisible", pvValue)
|
||||
Case Else
|
||||
Goto Trace_Error
|
||||
End Select
|
||||
oSettings.replaceByIndex(_InternalIndex, _Element)
|
||||
_ParentCommandBar.setSettings(oSettings)
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
Trace_Error:
|
||||
TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, , 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, cstThisSub, Erl)
|
||||
_PropertySet = False
|
||||
GoTo Exit_Function
|
||||
End Function ' _PropertySet
|
||||
|
||||
</script:module>
|
||||
2501
office-plugin/windows-office/share/basic/Access2Base/Control.xba
Normal file
2501
office-plugin/windows-office/share/basic/Access2Base/Control.xba
Normal file
File diff suppressed because it is too large
Load Diff
598
office-plugin/windows-office/share/basic/Access2Base/DataDef.xba
Normal file
598
office-plugin/windows-office/share/basic/Access2Base/DataDef.xba
Normal file
File diff suppressed because it is too large
Load Diff
1889
office-plugin/windows-office/share/basic/Access2Base/Database.xba
Normal file
1889
office-plugin/windows-office/share/basic/Access2Base/Database.xba
Normal file
File diff suppressed because it is too large
Load Diff
818
office-plugin/windows-office/share/basic/Access2Base/Dialog.xba
Normal file
818
office-plugin/windows-office/share/basic/Access2Base/Dialog.xba
Normal file
File diff suppressed because it is too large
Load Diff
2662
office-plugin/windows-office/share/basic/Access2Base/DoCmd.xba
Normal file
2662
office-plugin/windows-office/share/basic/Access2Base/DoCmd.xba
Normal file
File diff suppressed because it is too large
Load Diff
493
office-plugin/windows-office/share/basic/Access2Base/Event.xba
Normal file
493
office-plugin/windows-office/share/basic/Access2Base/Event.xba
Normal file
@@ -0,0 +1,493 @@
|
||||
<?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="Event" 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 EVENT
|
||||
Private _EventSource As Object
|
||||
Private _EventType As String
|
||||
Private _EventName As String
|
||||
Private _SubComponentName As String
|
||||
Private _SubComponentType As Long
|
||||
Private _ContextShortcut As String
|
||||
Private _ButtonLeft As Boolean ' com.sun.star.awt.MouseButton.XXX
|
||||
Private _ButtonRight As Boolean
|
||||
Private _ButtonMiddle As Boolean
|
||||
Private _XPos As Variant ' Null or Long
|
||||
Private _YPos As Variant ' Null or Long
|
||||
Private _ClickCount As Long
|
||||
Private _KeyCode As Integer ' com.sun.star.awt.Key.XXX
|
||||
Private _KeyChar As String
|
||||
Private _KeyFunction As Integer ' com.sun.star.awt.KeyFunction.XXX
|
||||
Private _KeyAlt As Boolean
|
||||
Private _KeyCtrl As Boolean
|
||||
Private _KeyShift As Boolean
|
||||
Private _FocusChangeTemporary As Boolean ' False if user action in same window
|
||||
Private _RowChangeAction As Long ' com.sun.star.sdb.RowChangeAction.XXX
|
||||
Private _Recommendation As String ' "IGNORE" or ""
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CONSTRUCTORS / DESTRUCTORS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Sub Class_Initialize()
|
||||
_Type = OBJEVENT
|
||||
_EventSource = Nothing
|
||||
_EventType = ""
|
||||
_EventName = ""
|
||||
_SubComponentName = ""
|
||||
_SubComponentType = -1
|
||||
_ContextShortcut = ""
|
||||
_ButtonLeft = False ' See com.sun.star.awt.MouseButton.XXX
|
||||
_ButtonRight = False
|
||||
_ButtonMiddle = False
|
||||
_XPos = Null
|
||||
_YPos = Null
|
||||
_ClickCount = 0
|
||||
_KeyCode = 0
|
||||
_KeyChar = ""
|
||||
_KeyFunction = com.sun.star.awt.KeyFunction.DONTKNOW
|
||||
_KeyAlt = False
|
||||
_KeyCtrl = False
|
||||
_KeyShift = False
|
||||
_FocusChangeTemporary = False
|
||||
_RowChangeAction = 0
|
||||
_Recommendation = ""
|
||||
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 ButtonLeft() As Variant
|
||||
ButtonLeft = _PropertyGet("ButtonLeft")
|
||||
End Property ' ButtonLeft (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get ButtonMiddle() As Variant
|
||||
ButtonMiddle = _PropertyGet("ButtonMiddle")
|
||||
End Property ' ButtonMiddle (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get ButtonRight() As Variant
|
||||
ButtonRight = _PropertyGet("ButtonRight")
|
||||
End Property ' ButtonRight (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get ClickCount() As Variant
|
||||
ClickCount = _PropertyGet("ClickCount")
|
||||
End Property ' ClickCount (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get ContextShortcut() As Variant
|
||||
ContextShortcut = _PropertyGet("ContextShortcut")
|
||||
End Property ' ContextShortcut (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get EventName() As Variant
|
||||
EventName = _PropertyGet("EventName")
|
||||
End Property ' EventName (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get EventSource() As Variant
|
||||
EventSource = _PropertyGet("EventSource")
|
||||
End Property ' EventSource (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get EventType() As Variant
|
||||
EventType = _PropertyGet("EventType")
|
||||
End Property ' EventType (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get FocusChangeTemporary() As Variant
|
||||
FocusChangeTemporary = _PropertyGet("FocusChangeTemporary")
|
||||
End Property ' FocusChangeTemporary (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get KeyAlt() As Variant
|
||||
KeyAlt = _PropertyGet("KeyAlt")
|
||||
End Property ' KeyAlt (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get KeyChar() As Variant
|
||||
KeyChar = _PropertyGet("KeyChar")
|
||||
End Property ' KeyChar (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get KeyCode() As Variant
|
||||
KeyCode = _PropertyGet("KeyCode")
|
||||
End Property ' KeyCode (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get KeyCtrl() As Variant
|
||||
KeyCtrl = _PropertyGet("KeyCtrl")
|
||||
End Property ' KeyCtrl (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get KeyFunction() As Variant
|
||||
KeyFunction = _PropertyGet("KeyFunction")
|
||||
End Property ' KeyFunction (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get KeyShift() As Variant
|
||||
KeyShift = _PropertyGet("KeyShift")
|
||||
End Property ' KeyShift (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get ObjectType() As String
|
||||
ObjectType = _PropertyGet("ObjectType")
|
||||
End Property ' ObjectType (get)
|
||||
|
||||
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 Recommendation() As Variant
|
||||
Recommendation = _PropertyGet("Recommendation")
|
||||
End Property ' Recommendation (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get RowChangeAction() As Variant
|
||||
RowChangeAction = _PropertyGet("RowChangeAction")
|
||||
End Property ' RowChangeAction (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Source() As Variant
|
||||
' Return the object having fired the event: Form, Control or SubForm
|
||||
' Else return the root Database object
|
||||
Source = _PropertyGet("Source")
|
||||
End Function ' Source (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get SubComponentName() As String
|
||||
SubComponentName = _PropertyGet("SubComponentName")
|
||||
End Property ' SubComponentName (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get SubComponentType() As Long
|
||||
SubComponentType = _PropertyGet("SubComponentType")
|
||||
End Property ' SubComponentType (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get XPos() As Variant
|
||||
XPos = _PropertyGet("XPos")
|
||||
End Property ' XPos (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get YPos() As Variant
|
||||
YPos = _PropertyGet("YPos")
|
||||
End Property ' YPos (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS METHODS ---
|
||||
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 -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- PRIVATE FUNCTIONS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Sub _Initialize(poEvent As Object)
|
||||
|
||||
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
|
||||
|
||||
Set oObject = poEvent.Source
|
||||
_EventSource = oObject
|
||||
sArray = Split(Utils._getUNOTypeName(poEvent), ".")
|
||||
_EventType = UCase(sArray(UBound(sArray)))
|
||||
If Utils._hasUNOProperty(poEvent, "EventName") Then _EventName = poEvent.EventName
|
||||
|
||||
Select Case _EventType
|
||||
Case "DOCUMENTEVENT"
|
||||
'SubComponent processing
|
||||
Select Case UCase(_EventName)
|
||||
Case UCase("OnSubComponentClosed"), UCase("OnSubComponentOpened")
|
||||
Set oSelection = poEvent.ViewController.getSelection()(0)
|
||||
_SubComponentName = oSelection.Name
|
||||
With com.sun.star.sdb.application.DatabaseObject
|
||||
Select Case oSelection.Type
|
||||
Case .TABLE : _SubComponentType = acTable
|
||||
Case .QUERY : _SubComponentType = acQuery
|
||||
Case .FORM : _SubComponentType = acForm
|
||||
Case .REPORT : _SubComponentType = acReport
|
||||
Case Else
|
||||
End Select
|
||||
End With
|
||||
Case Else
|
||||
End Select
|
||||
Case "EVENTOBJECT"
|
||||
Case "ACTIONEVENT"
|
||||
Case "FOCUSEVENT"
|
||||
_FocusChangeTemporary = poEvent.Temporary
|
||||
Case "ITEMEVENT"
|
||||
Case "INPUTEVENT", "KEYEVENT"
|
||||
_KeyCode = poEvent.KeyCode
|
||||
_KeyChar = poEvent.KeyChar
|
||||
_KeyFunction = poEvent.KeyFunc
|
||||
_KeyAlt = Utils._BitShift(poEvent.Modifiers, com.sun.star.awt.KeyModifier.MOD2)
|
||||
_KeyCtrl = Utils._BitShift(poEvent.Modifiers, com.sun.star.awt.KeyModifier.MOD1)
|
||||
_KeyShift = Utils._BitShift(poEvent.Modifiers, com.sun.star.awt.KeyModifier.SHIFT)
|
||||
Case "MOUSEEVENT"
|
||||
_ButtonLeft = Utils._BitShift(poEvent.Buttons, com.sun.star.awt.MouseButton.LEFT)
|
||||
_ButtonRight = Utils._BitShift(poEvent.Buttons, com.sun.star.awt.MouseButton.RIGHT)
|
||||
_ButtonMiddle = Utils._BitShift(poEvent.Buttons, com.sun.star.awt.MouseButton.MIDDLE)
|
||||
_XPos = poEvent.X
|
||||
_YPos = poEvent.Y
|
||||
_ClickCount = poEvent.ClickCount
|
||||
Case "ROWCHANGEEVENT"
|
||||
_RowChangeAction = poEvent.Action
|
||||
Case "TEXTEVENT"
|
||||
Case "ADJUSTMENTEVENT", "DOCKINGEVENT", "ENDDOCKINGEVENT", "ENDPOPUPMODEEVENT", "ENHANCEDMOUSEEVENT" _
|
||||
, "MENUEVENT", "PAINTEVENT", "SPINEVENT", "VCLCONTAINEREVENT", "WINDOWEVENT"
|
||||
Goto Exit_Function
|
||||
Case Else
|
||||
Goto Exit_Function
|
||||
End Select
|
||||
|
||||
' Evaluate ContextShortcut
|
||||
sShortcut = ""
|
||||
sImplementation = Utils._ImplementationName(oObject)
|
||||
|
||||
Select Case True
|
||||
Case sImplementation = "stardiv.Toolkit.UnoDialogControl" ' Dialog
|
||||
_ContextShortcut = "Dialogs!" & _EventSource.Model.Name
|
||||
Goto Exit_Function
|
||||
Case Left(sImplementation, 16) = "stardiv.Toolkit." ' Control in Dialog
|
||||
_ContextShortcut = "Dialogs!" & _EventSource.Context.Model.Name _
|
||||
& "!" & _EventSource.Model.Name
|
||||
Goto Exit_Function
|
||||
Case Else
|
||||
End Select
|
||||
|
||||
iCurrentDoc = _A2B_.CurrentDocIndex(, False)
|
||||
If iCurrentDoc < 0 Then Goto Exit_Function
|
||||
Set oDoc = _A2B_.CurrentDocument(iCurrentDoc)
|
||||
|
||||
' To manage 2x triggers of "Before record action" form event
|
||||
If _EventType = "ROWCHANGEEVENT" And sImplementation <> "com.sun.star.comp.forms.ODatabaseForm" Then _Recommendation = "IGNORE"
|
||||
|
||||
Do While sImplementation <> "SwXTextDocument"
|
||||
sAddShortcut = ""
|
||||
Select Case sImplementation
|
||||
Case "com.sun.star.comp.forms.OFormsCollection" ' Do nothing
|
||||
Case Else
|
||||
If Utils._hasUNOProperty(oObject, "Model") Then
|
||||
If oObject.Model.Name <> "MainForm" And oObject.Model.Name <> "Form" Then sAddShortcut = Utils._Surround(oObject.Model.Name)
|
||||
ElseIf Utils._hasUNOProperty(oObject, "Name") Then
|
||||
If oObject.Name <> "MainForm" And oObject.Name <> "Form" Then sAddShortcut = Utils._Surround(oObject.Name)
|
||||
End If
|
||||
If sAddShortcut <> "" Then
|
||||
If sImplementation = cstDatabaseForm And oDoc.DbConnect = DBCONNECTBASE Then sAddShortcut = sAddShortcut & ".Form"
|
||||
sShortcut = sAddShortcut & Iif(Len(sShortcut) > 0, "!" & sShortcut, "")
|
||||
End If
|
||||
End Select
|
||||
Select Case True
|
||||
Case Utils._hasUNOProperty(oObject, "Model")
|
||||
Set oObject = oObject.Model.Parent
|
||||
Case Utils._hasUNOProperty(oObject, "Parent")
|
||||
Set oObject = oObject.Parent
|
||||
Case Else
|
||||
Goto Exit_Function
|
||||
End Select
|
||||
sImplementation = Utils._ImplementationName(oObject)
|
||||
Loop
|
||||
' Add Forms! prefix
|
||||
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
|
||||
|
||||
sArray = Split(sShortcut, "!")
|
||||
' If presence of "Forms!myform!myform.Form", eliminate 2nd element
|
||||
' 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)
|
||||
End If
|
||||
' If first element ends with .Form, remove suffix
|
||||
If UBound(sArray) >= 1 Then
|
||||
If Len(sArray(1)) > 5 And Right(sArray(1), 5) = ".Form" Then sArray(1) = left(sArray(1), Len(sArray(1)) - 5)
|
||||
sShortcut = Join(sArray, "!")
|
||||
End If
|
||||
If Len(sShortcut) >= 2 Then
|
||||
If Right(sShortcut, 1) = "!" Then
|
||||
_ContextShortcut = Left(sShortcut, Len(sShortcut) - 1)
|
||||
Else
|
||||
_ContextShortcut = sShortcut
|
||||
End If
|
||||
End If
|
||||
|
||||
Exit_Function:
|
||||
Exit Sub
|
||||
Error_Function:
|
||||
TraceError(TRACEWARNING, Err, "Event.Initialize", Erl)
|
||||
GoTo Exit_Function
|
||||
End Sub ' _Initialize V0.9.1
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _PropertiesList() As Variant
|
||||
|
||||
Dim sSubComponentName As String, sSubComponentType As String
|
||||
sSubComponentName = Iif(_SubComponentType > -1, "SubComponentName", "")
|
||||
sSubComponentType = Iif(_SubComponentType > -1, "SubComponentType", "")
|
||||
Dim sXPos As String, sYPos As String
|
||||
sXPos = Iif(IsNull(_XPos), "", "XPos")
|
||||
sYPos = Iif(IsNull(_YPos), "", "YPos")
|
||||
|
||||
_PropertiesList = Utils._TrimArray(Array( _
|
||||
"ButtonLeft", "ButtonRight", "ButtonMiddle", "ClickCount" _
|
||||
, "ContextShortcut", "EventName", "EventType", "FocusChangeTemporary", _
|
||||
, "KeyAlt", "KeyChar", "KeyCode", "KeyCtrl", "KeyFunction", "KeyShift" _
|
||||
, "ObjectType", "Recommendation", "RowChangeAction", "Source" _
|
||||
, sSubComponentName, sSubComponentType, sXPos, sYPos _
|
||||
))
|
||||
|
||||
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("Event.get" & psProperty)
|
||||
|
||||
_PropertyGet = EMPTY
|
||||
|
||||
Select Case UCase(psProperty)
|
||||
Case UCase("ButtonLeft")
|
||||
_PropertyGet = _ButtonLeft
|
||||
Case UCase("ButtonMiddle")
|
||||
_PropertyGet = _ButtonMiddle
|
||||
Case UCase("ButtonRight")
|
||||
_PropertyGet = _ButtonRight
|
||||
Case UCase("ClickCount")
|
||||
_PropertyGet = _ClickCount
|
||||
Case UCase("ContextShortcut")
|
||||
_PropertyGet = _ContextShortcut
|
||||
Case UCase("FocusChangeTemporary")
|
||||
_PropertyGet = _FocusChangeTemporary
|
||||
Case UCase("EventName")
|
||||
_PropertyGet = _EventName
|
||||
Case UCase("EventSource")
|
||||
_PropertyGet = _EventSource
|
||||
Case UCase("EventType")
|
||||
_PropertyGet = _EventType
|
||||
Case UCase("KeyAlt")
|
||||
_PropertyGet = _KeyAlt
|
||||
Case UCase("KeyChar")
|
||||
_PropertyGet = _KeyChar
|
||||
Case UCase("KeyCode")
|
||||
_PropertyGet = _KeyCode
|
||||
Case UCase("KeyCtrl")
|
||||
_PropertyGet = _KeyCtrl
|
||||
Case UCase("KeyFunction")
|
||||
_PropertyGet = _KeyFunction
|
||||
Case UCase("KeyShift")
|
||||
_PropertyGet = _KeyShift
|
||||
Case UCase("ObjectType")
|
||||
_PropertyGet = _Type
|
||||
Case UCase("Recommendation")
|
||||
_PropertyGet = _Recommendation
|
||||
Case UCase("RowChangeAction")
|
||||
_PropertyGet = _RowChangeAction
|
||||
Case UCase("Source")
|
||||
If _ContextShortcut = "" Then
|
||||
_PropertyGet = _EventSource
|
||||
Else
|
||||
_PropertyGet = getObject(_ContextShortcut)
|
||||
End If
|
||||
Case UCase("SubComponentName")
|
||||
_PropertyGet = _SubComponentName
|
||||
Case UCase("SubComponentType")
|
||||
_PropertyGet = _SubComponentType
|
||||
Case UCase("XPos")
|
||||
If IsNull(_XPos) Then Goto Trace_Error
|
||||
_PropertyGet = _XPos
|
||||
Case UCase("YPos")
|
||||
If IsNull(_YPos) Then Goto Trace_Error
|
||||
_PropertyGet = _YPos
|
||||
Case Else
|
||||
Goto Trace_Error
|
||||
End Select
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub("Event.get" & psProperty)
|
||||
Exit Function
|
||||
Trace_Error:
|
||||
' Errors are not displayed to avoid display infinite cycling
|
||||
TraceError(TRACEWARNING, ERRPROPERTY, Utils._CalledSub(), 0, False, psProperty)
|
||||
_PropertyGet = EMPTY
|
||||
Goto Exit_Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, "Event._PropertyGet", Erl)
|
||||
_PropertyGet = EMPTY
|
||||
GoTo Exit_Function
|
||||
End Function ' _PropertyGet V1.1.0
|
||||
|
||||
</script:module>
|
||||
923
office-plugin/windows-office/share/basic/Access2Base/Field.xba
Normal file
923
office-plugin/windows-office/share/basic/Access2Base/Field.xba
Normal file
File diff suppressed because it is too large
Load Diff
1129
office-plugin/windows-office/share/basic/Access2Base/Form.xba
Normal file
1129
office-plugin/windows-office/share/basic/Access2Base/Form.xba
Normal file
File diff suppressed because it is too large
Load Diff
540
office-plugin/windows-office/share/basic/Access2Base/L10N.xba
Normal file
540
office-plugin/windows-office/share/basic/Access2Base/L10N.xba
Normal file
File diff suppressed because it is too large
Load Diff
300
office-plugin/windows-office/share/basic/Access2Base/Methods.xba
Normal file
300
office-plugin/windows-office/share/basic/Access2Base/Methods.xba
Normal file
@@ -0,0 +1,300 @@
|
||||
<?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="Methods" 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 Explicit
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function AddItem(Optional pvBox As Variant, ByVal Optional pvItem As Variant, ByVal Optional pvIndex) As Boolean
|
||||
' Add an item in a Listbox
|
||||
|
||||
Utils._SetCalledSub("AddItem")
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
|
||||
If IsMissing(pvBox) Or IsMissing(pvItem) Then Call _TraceArguments()
|
||||
If IsMissing(pvIndex) Then pvIndex = -1
|
||||
If Not Utils._CheckArgument(pvBox, 1, Array(CTLLISTBOX, CTLCOMBOBOX)) Then Goto Exit_Function
|
||||
|
||||
AddItem = pvBox.AddItem(pvItem, pvIndex)
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub("AddItem")
|
||||
Exit Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, "AddItem", Erl)
|
||||
AddItem = False
|
||||
GoTo Exit_Function
|
||||
End Function ' AddItem V0.9.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function hasProperty(Optional pvObject As Variant, ByVal Optional pvProperty As Variant) As Boolean
|
||||
' Return True if pvObject has a valid property called pvProperty (case-insensitive comparison !)
|
||||
|
||||
Dim vPropertiesList As Variant
|
||||
|
||||
Utils._SetCalledSub("hasProperty")
|
||||
If IsMissing(pvObject) Or IsMissing(pvProperty) Then Call _TraceArguments()
|
||||
|
||||
hasProperty = False
|
||||
If Not Utils._CheckArgument(pvObject, 1, Array(OBJCOLLECTION, OBJFORM, OBJSUBFORM, OBJCONTROL, OBJOPTIONGROUP, OBJEVENT _
|
||||
, OBJPROPERTY, OBJDATABASE, OBJQUERYDEF, OBJTABLEDEF, OBJRECORDSET _
|
||||
)) Then Goto Exit_Function
|
||||
If Not Utils._CheckArgument(pvProperty, 2, vbString) Then Goto Exit_Function
|
||||
|
||||
hasProperty = pvObject.hasProperty(pvProperty)
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub("hasProperty")
|
||||
Exit Function
|
||||
End Function ' hasProperty V0.9.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Move(Optional pvObject As Object _
|
||||
, 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("Move")
|
||||
If IsMissing(pvObject) Then Call _TraceArguments()
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
Move = False
|
||||
If Not Utils._CheckArgument(pvObject, 1, Array(OBJFORM, OBJDIALOG)) Then Goto Exit_Function
|
||||
If IsMissing(pvLeft) Then Call _TraceArguments()
|
||||
If IsMissing(pvTop) Then pvTop = -1
|
||||
If IsMissing(pvWidth) Then pvWidth = -1
|
||||
If IsMissing(pvHeight) Then pvHeight = -1
|
||||
|
||||
Move = pvObject.Move(pvLeft, pvTop, pvWidth, pvHeight)
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub("Move")
|
||||
Exit Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, "Move", Erl)
|
||||
GoTo Exit_Function
|
||||
End Function ' Move V.0.9.1
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function OpenHelpFile()
|
||||
' Open the help file from the Help menu (IDE only)
|
||||
Const cstHelpFile = "http://www.access2base.com/access2base.html"
|
||||
|
||||
On Local Error Resume Next
|
||||
Call _ShellExecute(cstHelpFile)
|
||||
|
||||
End Function ' OpenHelpFile V0.8.5
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Properties(Optional pvObject As Variant, ByVal Optional pvIndex As Variant) As Variant
|
||||
' Return
|
||||
' a Collection object if pvIndex absent
|
||||
' a Property object otherwise
|
||||
|
||||
Dim vProperties As Variant, oCounter As Variant, opProperty As Variant
|
||||
Dim vPropertiesList() As Variant
|
||||
|
||||
If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments()
|
||||
Utils._SetCalledSub("Properties")
|
||||
|
||||
Set vProperties = Nothing
|
||||
If Not Utils._CheckArgument(pvObject, 1, Array(OBJCOLLECTION, OBJFORM, OBJSUBFORM, OBJCONTROL, OBJOPTIONGROUP, OBJEVENT _
|
||||
, OBJPROPERTY, OBJDATABASE, OBJQUERYDEF, OBJTABLEDEF, OBJRECORDSET _
|
||||
)) Then Goto Exit_Function
|
||||
|
||||
If IsMissing(pvIndex) Then vProperties = pvObject.Properties Else vProperties = pvObject.Properties(pvIndex)
|
||||
|
||||
Exit_Function:
|
||||
Set Properties = vProperties
|
||||
Utils._ResetCalledSub("Properties")
|
||||
Exit Function
|
||||
End Function ' Properties V0.9.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Refresh(Optional pvObject As Variant) As Boolean
|
||||
' Refresh data with its most recent value in the database in a form or subform
|
||||
Utils._SetCalledSub("Refresh")
|
||||
If IsMissing(pvObject) Then Call _TraceArguments()
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
Refresh = False
|
||||
If Not Utils._CheckArgument(pvObject, 1, Array(OBJFORM, OBJSUBFORM)) Then Goto Exit_Function
|
||||
|
||||
Refresh = pvObject.Refresh()
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub("Refresh")
|
||||
Exit Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, "Refresh", Erl)
|
||||
GoTo Exit_Function
|
||||
End Function ' Refresh V0.9.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function RemoveItem(Optional pvBox As Variant,ByVal Optional pvIndex) As Boolean
|
||||
' Remove an item from a Listbox
|
||||
' Index may be a string value or an index-position
|
||||
|
||||
Utils._SetCalledSub("RemoveItem")
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
|
||||
If IsMissing(pvBox) Or IsMissing(pvIndex) Then Call _TraceArguments()
|
||||
If Not Utils._CheckArgument(pvBox, 1, Array(CTLLISTBOX, CTLCOMBOBOX)) Then Goto Exit_Function
|
||||
|
||||
RemoveItem = pvBox.RemoveItem(pvIndex)
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub("RemoveItem")
|
||||
Exit Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, "RemoveItem", Erl)
|
||||
RemoveItem = False
|
||||
GoTo Exit_Function
|
||||
End Function ' RemoveItem V0.9.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Requery(Optional pvObject As Variant) As Boolean
|
||||
' Refresh data displayed in a form, subform, combobox or listbox
|
||||
Utils._SetCalledSub("Requery")
|
||||
If IsMissing(pvObject) Then Call _TraceArguments()
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
If Not Utils._CheckArgument(pvObject, 1, Array(OBJFORM, OBJCONTROL, OBJSUBFORM)) Then Goto Exit_Function
|
||||
|
||||
Requery = pvObject.Requery()
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub("Requery")
|
||||
Exit Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, "Requery", Erl)
|
||||
GoTo Exit_Function
|
||||
End Function ' Requery V0.9.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function SetFocus(Optional pvObject As Variant) As Boolean
|
||||
' Execute SetFocus method
|
||||
Utils._SetCalledSub("setFocus")
|
||||
If IsMissing(pvObject) Then Call _TraceArguments()
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
If Not Utils._CheckArgument(pvObject, 1, Array(OBJFORM, OBJCONTROL)) Then Goto Exit_Function
|
||||
|
||||
SetFocus = pvObject.setFocus()
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub("SetFocus")
|
||||
Exit Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, "SetFocus", Erl)
|
||||
Goto Exit_Function
|
||||
Error_Grid:
|
||||
TraceError(TRACEFATAL, ERRFOCUSINGRID, Utils._CalledSub(), 0, 1, Array(pvObject._Name, ocGrid._Name))
|
||||
Goto Exit_Function
|
||||
End Function ' SetFocus V0.9.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- PRIVATE FUNCTIONS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function _OptionGroup(ByVal pvGroupName As Variant _
|
||||
, ByVal psParentType As String _
|
||||
, poComponent As Object _
|
||||
, poParent As Object _
|
||||
) As Variant
|
||||
' Return either an error or an object of type OPTIONGROUP based on its name
|
||||
|
||||
If IsMissing(pvGroupName) Then Call _TraceArguments()
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
Set _OptionGroup = Nothing
|
||||
|
||||
If Not Utils._CheckArgument(pvGroupName, 1, vbString) Then Goto Exit_Function
|
||||
|
||||
Dim ogGroup As Variant, i As Integer, j As Integer, bFound As Boolean
|
||||
Dim vOptionButtons() As Variant, sGroupName As String
|
||||
Dim lXY() As Long, iIndex() As Integer ' Two indexes X-Y coordinates
|
||||
Dim oView As Object, oDatabaseForm As Object, vControls As Variant
|
||||
|
||||
Const cstPixels = 10 ' Tolerance on coordinates when drawn approximately
|
||||
|
||||
bFound = False
|
||||
Select Case psParentType
|
||||
Case CTLPARENTISFORM
|
||||
'poParent is a forms collection, find the appropriate database form
|
||||
For i = 0 To poParent.Count - 1
|
||||
Set oDatabaseForm = poParent.getByIndex(i)
|
||||
If Not IsNull(oDatabaseForm) Then
|
||||
For j = 0 To oDatabaseForm.GroupCount - 1 ' Does a group with the right name exist ?
|
||||
oDatabaseForm.getGroup(j, vOptionButtons, sGroupName)
|
||||
If UCase(sGroupName) = UCase(Utils._Trim(pvGroupName)) Then
|
||||
bFound = True
|
||||
Exit For
|
||||
End If
|
||||
Next j
|
||||
If bFound Then Exit For
|
||||
End If
|
||||
If bFound Then Exit For
|
||||
Next i
|
||||
Case CTLPARENTISSUBFORM
|
||||
'poParent is already a database form
|
||||
Set oDatabaseForm = poParent
|
||||
For j = 0 To oDatabaseForm.GroupCount - 1 ' Does a group with the right name exist ?
|
||||
oDatabaseForm.getGroup(j, vOptionButtons, sGroupName)
|
||||
If UCase(sGroupName) = UCase(Utils._Trim(pvGroupName)) Then
|
||||
bFound = True
|
||||
Exit For
|
||||
End If
|
||||
Next j
|
||||
End Select
|
||||
|
||||
If bFound Then
|
||||
|
||||
ogGroup = New Optiongroup
|
||||
ogGroup._This = ogGroup
|
||||
ogGroup._Name = sGroupName
|
||||
ogGroup._ButtonsGroup = vOptionButtons
|
||||
ogGroup._Count = UBound(vOptionButtons) + 1
|
||||
ogGroup._ParentType = psParentType
|
||||
ogGroup._MainForm = oDatabaseForm.Name
|
||||
Set ogGroup._ParentComponent = poComponent
|
||||
|
||||
ReDim lXY(1, ogGroup._Count - 1)
|
||||
ReDim iIndex(ogGroup._Count - 1)
|
||||
For i = 0 To ogGroup._Count - 1 ' Find the position of each radiobutton
|
||||
Set oView = poComponent.CurrentController.getControl(ogGroup._ButtonsGroup(i))
|
||||
lXY(0, i) = oView.PosSize.X
|
||||
lXY(1, i) = oView.PosSize.Y
|
||||
Next i
|
||||
For i = 0 To ogGroup._Count - 1 ' Sort them on XY coordinates
|
||||
If i = 0 Then
|
||||
iIndex(0) = 0
|
||||
Else
|
||||
iIndex(i) = i
|
||||
For j = i - 1 To 0 Step -1
|
||||
If lXY(1, i) - lXY(1, j) < - cstPixels Or ( Abs(lXY(1, i) - lXY(1, j)) <= cstPixels And lXY(0, i) - lXY(0, j) < - cstPixels ) Then
|
||||
iIndex(i) = iIndex(j)
|
||||
iIndex(j) = iIndex(j) + 1
|
||||
End If
|
||||
Next j
|
||||
End If
|
||||
Next i
|
||||
ogGroup._ButtonsIndex = iIndex()
|
||||
|
||||
Set _OptionGroup = ogGroup
|
||||
|
||||
Else
|
||||
|
||||
Set _OptionGroup = Nothing
|
||||
TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, , Array(1, pvGroupName))
|
||||
|
||||
End If
|
||||
|
||||
Exit_Function:
|
||||
Exit Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err,"_OptionGroup", Erl)
|
||||
GoTo Exit_Function
|
||||
End Function ' _OptionGroup V1.1.0
|
||||
|
||||
</script:module>
|
||||
722
office-plugin/windows-office/share/basic/Access2Base/Module.xba
Normal file
722
office-plugin/windows-office/share/basic/Access2Base/Module.xba
Normal file
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,315 @@
|
||||
<?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="OptionGroup" 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 _Name As String
|
||||
Private _ParentType As String
|
||||
Private _ParentComponent As Object
|
||||
Private _MainForm As String
|
||||
Private _DocEntry As Integer
|
||||
Private _DbEntry As Integer
|
||||
Private _ButtonsGroup() As Variant
|
||||
Private _ButtonsIndex() As Variant
|
||||
Private _Count As Long
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CONSTRUCTORS / DESTRUCTORS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Sub Class_Initialize()
|
||||
_Type = OBJOPTIONGROUP
|
||||
Set _This = Nothing
|
||||
Set _Parent = Nothing
|
||||
_Name = ""
|
||||
_ParentType = ""
|
||||
_ParentComponent = Nothing
|
||||
_DocEntry = -1
|
||||
_DbEntry = -1
|
||||
_ButtonsGroup = Array()
|
||||
_ButtonsIndex = Array()
|
||||
_Count = 0
|
||||
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 Count() As Variant
|
||||
Count = _PropertyGet("Count")
|
||||
End Property ' Count (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 -----------------------------------------------------------------------------------------------------------------------
|
||||
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 Value() As Variant
|
||||
Value = _PropertyGet("Value")
|
||||
End Property ' Value (get)
|
||||
|
||||
Property Let Value(ByVal pvValue As Variant)
|
||||
Call _PropertySet("Value", pvValue)
|
||||
End Property ' Value (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("OptionGroup.Controls")
|
||||
|
||||
Dim ocControl As Variant, iArgNr As Integer, i As Integer
|
||||
Dim oCounter As Object
|
||||
|
||||
Set ocControl = Nothing
|
||||
|
||||
If IsMissing(pvIndex) Then ' No argument, return Collection object
|
||||
Set oCounter = New Collect
|
||||
Set oCounter._This = oCounter
|
||||
oCounter._CollType = COLLCONTROLS
|
||||
Set oCounter._Parent = _This
|
||||
oCounter._Count = _Count
|
||||
Set Controls = oCounter
|
||||
Goto Exit_Function
|
||||
End If
|
||||
|
||||
If _IsLeft(_A2B_.CalledSub, "OptionGroup.") Then iArgNr = 1 Else iArgNr = 2
|
||||
If Not Utils._CheckArgument(pvIndex, iArgNr, Utils._AddNumeric()) Then Goto Exit_Function
|
||||
If pvIndex < 0 Or pvIndex > _Count - 1 Then Goto Trace_Error_Index
|
||||
|
||||
' Start building the ocControl object
|
||||
' Determine exact name
|
||||
Set ocControl = New Control
|
||||
Set ocControl._This = ocControl
|
||||
Set ocControl._Parent = _This
|
||||
ocControl._ParentType = CTLPARENTISGROUP
|
||||
|
||||
ocControl._Shortcut = ""
|
||||
For i = 0 To _Count - 1
|
||||
If _ButtonsIndex(i) = pvIndex Then
|
||||
Set ocControl.ControlModel = _ButtonsGroup(i)
|
||||
Select Case _ParentType
|
||||
Case CTLPARENTISDIALOG : ocControl._Name = _ButtonsGroup(i).Name
|
||||
Case Else : ocControl._Name = _Name ' OptionGroup and individual radio buttons share the same name
|
||||
End Select
|
||||
ocControl._ImplementationName = ocControl.ControlModel.getImplementationName()
|
||||
Exit For
|
||||
End If
|
||||
Next i
|
||||
ocControl._FormComponent = _ParentComponent
|
||||
ocControl._ClassId = acRadioButton
|
||||
Select Case _ParentType
|
||||
Case CTLPARENTISDIALOG : Set ocControl.ControlView = _ParentComponent.getControl(ocControl._Name)
|
||||
Case Else : Set ocControl.ControlView = _ParentComponent.CurrentController.getControl(ocControl.ControlModel)
|
||||
End Select
|
||||
|
||||
ocControl._Initialize()
|
||||
ocControl._DocEntry = _DocEntry
|
||||
ocControl._DbEntry = _DbEntry
|
||||
Set Controls = ocControl
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub("OptionGroup.Controls")
|
||||
Exit Function
|
||||
Trace_Error_Index:
|
||||
TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0, 1)
|
||||
Set Controls = Nothing
|
||||
Goto Exit_Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, "OptionGroup.Controls", Erl)
|
||||
Set Controls = Nothing
|
||||
GoTo Exit_Function
|
||||
End Function ' Controls
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
|
||||
' Return property value of psProperty property name
|
||||
|
||||
Utils._SetCalledSub("OptionGroup.getProperty")
|
||||
If IsMissing(pvProperty) Then Call _TraceArguments()
|
||||
getProperty = _PropertyGet(pvProperty)
|
||||
Utils._ResetCalledSub("OptionGroup.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 setProperty(ByVal Optional psProperty As String, ByVal Optional pvValue As Variant) As Boolean
|
||||
' Return True if property setting OK
|
||||
Utils._SetCalledSub("OptionGroup.setProperty")
|
||||
setProperty = _PropertySet(psProperty, pvValue)
|
||||
Utils._ResetCalledSub("OptionGroup.setProperty")
|
||||
End Function
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- PRIVATE FUNCTIONS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _PropertiesList() As Variant
|
||||
|
||||
_PropertiesList = Array("Count", "Name", "ObjectType", "Value")
|
||||
|
||||
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("OptionGroup.get" & psProperty)
|
||||
|
||||
'Execute
|
||||
Dim oDatabase As Object, vBookmark As Variant
|
||||
Dim iValue As Integer, i As Integer
|
||||
_PropertyGet = EMPTY
|
||||
Select Case UCase(psProperty)
|
||||
Case UCase("Count")
|
||||
_PropertyGet = _Count
|
||||
Case UCase("Name")
|
||||
_PropertyGet = _Name
|
||||
Case UCase("ObjectType")
|
||||
_PropertyGet = _Type
|
||||
Case UCase("Value")
|
||||
iValue = -1
|
||||
For i = 0 To _Count - 1 ' Find the selected RadioButton
|
||||
If _ButtonsGroup(i).State = 1 Then
|
||||
iValue = _ButtonsIndex(i)
|
||||
Exit For
|
||||
End If
|
||||
Next i
|
||||
_PropertyGet = iValue
|
||||
Case Else
|
||||
Goto Trace_Error
|
||||
End Select
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub("OptionGroup.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, "OptionGroup._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("OptionGroup.set" & psProperty)
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
_PropertySet = True
|
||||
|
||||
'Execute
|
||||
Dim i As Integer, iRadioIndex As Integer, oModel As Object, iArgNr As Integer
|
||||
|
||||
If _IsLeft(_A2B_.CalledSub, "OptionGroup.") Then iArgNr = 1 Else iArgNr = 2
|
||||
Select Case UCase(psProperty)
|
||||
Case UCase("Value")
|
||||
If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
|
||||
If pvValue < 0 Or pvValue > _Count - 1 Then Goto Trace_Error_Value
|
||||
For i = 0 To _Count - 1
|
||||
_ButtonsGroup(i).State = 0
|
||||
If _ButtonsIndex(i) = pvValue Then iRadioIndex = i
|
||||
Next i
|
||||
_ButtonsGroup(iRadioIndex).State = 1
|
||||
Set oModel = _ButtonsGroup(iRadioIndex)
|
||||
If Utils._hasUNOProperty(oModel, "DataField") Then
|
||||
If Not IsNull(oModel.Datafield) And Not IsEmpty(oModel.Datafield) Then
|
||||
If oModel.Datafield <> "" And Utils._hasUNOMethod(oModel, "commit") Then oModel.commit() ' f.i. checkboxes have no commit method ?? [PASTIM]
|
||||
End If
|
||||
End If
|
||||
Case Else
|
||||
Goto Trace_Error
|
||||
End Select
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub("OptionGroup.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, "OptionGroup._PropertySet", Erl)
|
||||
_PropertySet = False
|
||||
GoTo Exit_Function
|
||||
End Function ' _PropertySet
|
||||
|
||||
</script:module>
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,152 @@
|
||||
<?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="Property" 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 PROPERTY
|
||||
Private _This As Object ' Workaround for absence of This builtin function
|
||||
Private _Parent As Object
|
||||
Private _Name As String
|
||||
Private _Value As Variant
|
||||
Private _ParentDatabase As Object
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CONSTRUCTORS / DESTRUCTORS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Sub Class_Initialize()
|
||||
_Type = OBJPROPERTY
|
||||
Set _This = Nothing
|
||||
Set _Parent = Nothing
|
||||
_Name = ""
|
||||
_Value = Null
|
||||
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 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 -----------------------------------------------------------------------------------------------------------------------
|
||||
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 Value() As Variant
|
||||
Value = _PropertyGet("Value")
|
||||
End Property ' Value (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS METHODS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
|
||||
' Return property value of psProperty property name
|
||||
|
||||
Utils._SetCalledSub("Property.getProperty")
|
||||
If IsMissing(pvProperty) Then Call _TraceArguments()
|
||||
getProperty = _PropertyGet(pvProperty)
|
||||
Utils._ResetCalledSub("Property.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 -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- PRIVATE FUNCTIONS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _PropertiesList() As Variant
|
||||
_PropertiesList = Array("Name", "ObjectType", "Value")
|
||||
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("Property.get" & psProperty)
|
||||
_PropertyGet = Nothing
|
||||
|
||||
Select Case UCase(psProperty)
|
||||
Case UCase("Name")
|
||||
_PropertyGet = _Name
|
||||
Case UCase("ObjectType")
|
||||
_PropertyGet = _Type
|
||||
Case UCase("Value")
|
||||
_PropertyGet = _Value
|
||||
Case Else
|
||||
Goto Trace_Error
|
||||
End Select
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub("Property.get" & psProperty)
|
||||
Exit Function
|
||||
Trace_Error:
|
||||
TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty)
|
||||
_PropertyGet = Nothing
|
||||
Goto Exit_Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, "Property._PropertyGet", Erl)
|
||||
_PropertyGet = Nothing
|
||||
GoTo Exit_Function
|
||||
End Function ' _PropertyGet
|
||||
|
||||
</script:module>
|
||||
613
office-plugin/windows-office/share/basic/Access2Base/Python.xba
Normal file
613
office-plugin/windows-office/share/basic/Access2Base/Python.xba
Normal file
File diff suppressed because it is too large
Load Diff
1274
office-plugin/windows-office/share/basic/Access2Base/Recordset.xba
Normal file
1274
office-plugin/windows-office/share/basic/Access2Base/Recordset.xba
Normal file
File diff suppressed because it is too large
Load Diff
311
office-plugin/windows-office/share/basic/Access2Base/Root_.xba
Normal file
311
office-plugin/windows-office/share/basic/Access2Base/Root_.xba
Normal file
@@ -0,0 +1,311 @@
|
||||
<?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="Root_" 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 --- FOR INTERNAL USE ONLY ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS ROOT FIELDS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
Private ErrorHandler As Boolean
|
||||
Private MinimalTraceLevel As Integer
|
||||
Private TraceLogs() As Variant
|
||||
Private TraceLogCount As Integer
|
||||
Private TraceLogLast As Integer
|
||||
Private TraceLogMaxEntries As Integer
|
||||
Private LastErrorCode As Integer
|
||||
Private LastErrorLevel As String
|
||||
Private ErrorText As String
|
||||
Private ErrorLongText As String
|
||||
Private CalledSub As String
|
||||
Private DebugPrintShort As Boolean
|
||||
Private Introspection As Object ' com.sun.star.beans.Introspection
|
||||
Private VersionNumber As String ' Actual Access2Base version number
|
||||
Private Locale As String
|
||||
Private ExcludeA2B As Boolean
|
||||
Private TextSearch As Object
|
||||
Private SearchOptions As Variant
|
||||
Private FindRecord As Object
|
||||
Private StatusBar As Object
|
||||
Private Dialogs As Object ' Collection
|
||||
Private TempVars As Object ' Collection
|
||||
Private CurrentDoc() As Variant ' Array of document containers - [0] = Base document, [1 ... N] = other documents
|
||||
Private PythonCache() As Variant ' Array of objects created in Python scripts
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CONSTRUCTORS / DESTRUCTORS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Sub Class_Initialize()
|
||||
VersionNumber = Access2Base_Version
|
||||
ErrorHandler = True
|
||||
MinimalTraceLevel = 0
|
||||
TraceLogs() = Array()
|
||||
TraceLogCount = 0
|
||||
TraceLogLast = 0
|
||||
TraceLogMaxEntries = 0
|
||||
LastErrorCode = 0
|
||||
LastErrorLevel = ""
|
||||
ErrorText = ""
|
||||
ErrorLongText = ""
|
||||
CalledSub = ""
|
||||
DebugPrintShort = True
|
||||
Locale = L10N._GetLocale()
|
||||
ExcludeA2B = True
|
||||
Set Introspection = CreateUnoService("com.sun.star.beans.Introspection")
|
||||
Set TextSearch = CreateUnoService("com.sun.star.util.TextSearch")
|
||||
SearchOptions = New com.sun.star.util.SearchOptions
|
||||
With SearchOptions
|
||||
.algorithmType = com.sun.star.util.SearchAlgorithms.REGEXP
|
||||
.searchFlag = 0
|
||||
.transliterateFlags = com.sun.star.i18n.TransliterationModules.IGNORE_CASE
|
||||
End With
|
||||
Set FindRecord = Nothing
|
||||
Set StatusBar = Nothing
|
||||
Set Dialogs = New Collection
|
||||
Set TempVars = New Collection
|
||||
CurrentDoc = Array()
|
||||
ReDim CurrentDoc(0 To 0)
|
||||
Set CurrentDoc(0) = Nothing
|
||||
PythonCache = Array()
|
||||
End Sub ' Constructor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Sub Class_Terminate()
|
||||
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 -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS METHODS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function AddPython(ByRef pvObject As Variant) As Long
|
||||
' Store the object as a new entry in PythonCache and return its entry number
|
||||
|
||||
Dim lVars As Long, vObject As Variant
|
||||
|
||||
lVars = UBound(PythonCache) + 1
|
||||
ReDim Preserve PythonCache(0 To lVars)
|
||||
PythonCache(lVars) = pvObject
|
||||
|
||||
AddPython = lVars
|
||||
|
||||
End Function ' AddPython V6.4
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Sub CloseConnection()
|
||||
' Close all connections established by current document to free memory.
|
||||
' - if Base document => close the one concerned database connection
|
||||
' - if non-Base documents => close the connections of each individual standalone form
|
||||
|
||||
Dim i As Integer, iCurrentDoc As Integer
|
||||
Dim vDbContainer As Variant, vDbContainers() As Variant, vDocContainer As Variant
|
||||
|
||||
If ErrorHandler Then On Local Error Goto Error_Sub
|
||||
|
||||
If Not IsArray(CurrentDoc) Then Goto Exit_Sub
|
||||
If UBound(CurrentDoc) < 0 Then Goto Exit_Sub
|
||||
iCurrentDoc = CurrentDocIndex( , False) ' False prevents error raising if not found
|
||||
If iCurrentDoc < 0 Then GoTo Exit_Sub ' If not found ignore
|
||||
|
||||
vDocContainer = CurrentDocument(iCurrentDoc)
|
||||
With vDocContainer
|
||||
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()
|
||||
Set .DbContainers(i).Database = Nothing
|
||||
End If
|
||||
TraceLog(TRACEANY, UCase(CalledSub) & " " & .URL & Iif(i = 0, "", " Form=" & .DbContainers(i).FormName), False)
|
||||
Set .DbContainers(i) = Nothing
|
||||
Next i
|
||||
.DbContainers = Array()
|
||||
.URL = ""
|
||||
.DbConnect = 0
|
||||
.Active = False
|
||||
Set .Document = Nothing
|
||||
End With
|
||||
CurrentDoc(iCurrentDoc) = vDocContainer
|
||||
|
||||
Exit_Sub:
|
||||
Exit Sub
|
||||
Error_Sub:
|
||||
TraceError(TRACEABORT, Err, CalledSub, Erl, False) ' No error message addressed to the user, only stored in console
|
||||
GoTo Exit_Sub
|
||||
End Sub ' CloseConnection
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function CurrentDb() As Object
|
||||
' Returns _A2B_.CurrentDocument().Database as an object to allow access to its properties
|
||||
|
||||
Dim iCurrentDoc As Integer
|
||||
|
||||
Set CurrentDb = Nothing
|
||||
|
||||
If Not IsArray(CurrentDoc) Then Goto Exit_Function
|
||||
If UBound(CurrentDoc) < 0 Then Goto Exit_Function
|
||||
iCurrentDoc = CurrentDocIndex(, False) ' False = no abort
|
||||
If iCurrentDoc >= 0 Then
|
||||
If UBound(CurrentDoc(iCurrentDoc).DbContainers) >= 0 Then Set CurrentDb = CurrentDoc(iCurrentDoc).DbContainers(0).Database
|
||||
End If
|
||||
|
||||
Exit_Function:
|
||||
Exit Function
|
||||
End Function ' CurrentDb
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function CurrentDocIndex(Optional pvURL As Variant, Optional pbAbort As Variant) As Integer
|
||||
' Returns the entry in CurrentDoc(...) referring to the current document
|
||||
|
||||
Dim i As Integer, bFound As Boolean, sURL As String
|
||||
Const cstBase = "com.sun.star.comp.dba.ODatabaseDocument"
|
||||
|
||||
bFound = False
|
||||
CurrentDocIndex = -1
|
||||
|
||||
If Not IsArray(CurrentDoc) Then Goto Trace_Error
|
||||
If UBound(CurrentDoc) < 0 Then Goto Trace_Error
|
||||
For i = 1 To UBound(CurrentDoc) ' [0] reserved to database .odb document
|
||||
If IsMissing(pvURL) Then ' Not on 1 single line ?!?
|
||||
If Utils._hasUNOProperty(ThisComponent, "URL") Then
|
||||
sURL = ThisComponent.URL
|
||||
Else
|
||||
Exit For ' f.i. ThisComponent = Basic IDE ...
|
||||
End If
|
||||
Else
|
||||
sURL = pvURL ' To support the SelectObject action
|
||||
End If
|
||||
If CurrentDoc(i).Active And CurrentDoc(i).URL = sURL Then
|
||||
CurrentDocIndex = i
|
||||
bFound = True
|
||||
Exit For
|
||||
End If
|
||||
Next i
|
||||
|
||||
If Not bFound Then
|
||||
If IsNull(CurrentDoc(0)) Then GoTo Trace_Error
|
||||
With CurrentDoc(0)
|
||||
If Not .Active Then GoTo Trace_Error
|
||||
If IsNull(.Document) Then GoTo Trace_Error
|
||||
End With
|
||||
CurrentDocIndex = 0
|
||||
End If
|
||||
|
||||
Exit_Function:
|
||||
Exit Function
|
||||
Trace_Error:
|
||||
If IsMissing(pbAbort) Then pbAbort = True
|
||||
If pbAbort Then TraceError(TRACEABORT, ERRDBNOTCONNECTED, Utils._CalledSub(), 0, 1) Else CurrentDocIndex = -1
|
||||
Goto Exit_Function
|
||||
End Function ' CurrentDocIndex
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function CurrentDocument(ByVal Optional piDocIndex As Integer) As Variant
|
||||
' Returns the CurrentDoc(...) referring to the current document or to the argument
|
||||
|
||||
Dim iDocIndex As Integer
|
||||
If IsMissing(piDocIndex) Then iDocIndex = CurrentDocIndex(, False) Else iDocIndex = piDocIndex
|
||||
If iDocIndex >= 0 And iDocIndex <= UBound(CurrentDoc) Then Set CurrentDocument = CurrentDoc(iDocIndex) Else Set CurrentDocument = Nothing
|
||||
|
||||
End Function
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Sub Dump()
|
||||
' For debugging purposes
|
||||
Dim i As Integer, j As Integer, vCurrentDoc As Variant
|
||||
On Local Error Resume Next
|
||||
|
||||
DebugPrint "Version", VersionNumber
|
||||
DebugPrint "TraceLevel", MinimalTraceLevel
|
||||
DebugPrint "TraceCount", TraceLogCount
|
||||
DebugPrint "CalledSub", CalledSub
|
||||
If IsArray(CurrentDoc) Then
|
||||
For i = 0 To UBound(CurrentDoc)
|
||||
vCurrentDoc = CurrentDoc(i)
|
||||
If Not IsNull(vCurrentDoc) Then
|
||||
DebugPrint i, "URL", vCurrentDoc.URL
|
||||
For j = 0 To UBound(vCurrentDoc.DbContainers)
|
||||
DebugPrint i, j, "Form", vCurrentDoc.DbContainers(j).FormName
|
||||
DebugPrint i, j, "Database", vCurrentDoc.DbContainers(j).Database.Title
|
||||
Next j
|
||||
End If
|
||||
Next i
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function hasItem(psCollType As String, ByVal psName As String) As Boolean
|
||||
' Return True if psName if in the collection
|
||||
|
||||
Dim oItem As Object
|
||||
On Local Error Goto Error_Function ' Whatever ErrorHandler !
|
||||
|
||||
hasItem = True
|
||||
Select Case psCollType
|
||||
Case COLLALLDIALOGS
|
||||
Set oItem = Dialogs.Item(UCase(psName))
|
||||
Case COLLTEMPVARS
|
||||
Set oItem = TempVars.Item(UCase(psName))
|
||||
Case Else
|
||||
hasItem = False
|
||||
End Select
|
||||
|
||||
Exit_Function:
|
||||
Exit Function
|
||||
Error_Function: ' Item by key aborted
|
||||
hasItem = False
|
||||
GoTo Exit_Function
|
||||
End Function ' hasItem
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- PRIVATE FUNCTIONS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function _CurrentDb(ByVal Optional piDocEntry As Integer, ByVal Optional piDbEntry As Integer) As Variant
|
||||
REM Without arguments same as CurrentDb() except that it generates an error if database not connected (internal use)
|
||||
REM With 2 arguments return the corresponding entry in Root
|
||||
|
||||
Dim odbDatabase As Variant
|
||||
If IsMissing(piDocEntry) Then
|
||||
Set odbDatabase = CurrentDb()
|
||||
Else
|
||||
If Not IsArray(CurrentDoc) Then Goto Trace_Error
|
||||
If piDocEntry < 0 Or piDbEntry < 0 Then Goto Trace_Error
|
||||
If piDocEntry > UBound(CurrentDoc) Then Goto Trace_Error
|
||||
If piDbEntry > UBound(CurrentDoc(piDocEntry).DbContainers) Then Goto Trace_Error
|
||||
Set odbDatabase = CurrentDoc(piDocEntry).DbContainers(piDbEntry).Database
|
||||
End If
|
||||
If IsNull(odbDatabase) Then GoTo Trace_Error
|
||||
|
||||
Exit_Function:
|
||||
Set _CurrentDb = odbDatabase
|
||||
Exit Function
|
||||
Trace_Error:
|
||||
TraceError(TRACEABORT, ERRDBNOTCONNECTED, Utils._CalledSub(), 0, 1)
|
||||
Goto Exit_Function
|
||||
End Function ' _CurrentDb
|
||||
|
||||
</script:module>
|
||||
757
office-plugin/windows-office/share/basic/Access2Base/SubForm.xba
Normal file
757
office-plugin/windows-office/share/basic/Access2Base/SubForm.xba
Normal file
File diff suppressed because it is too large
Load Diff
195
office-plugin/windows-office/share/basic/Access2Base/TempVar.xba
Normal file
195
office-plugin/windows-office/share/basic/Access2Base/TempVar.xba
Normal file
@@ -0,0 +1,195 @@
|
||||
<?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="TempVar" 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 TEMPVAR
|
||||
Private _This As Object ' Workaround for absence of This builtin function
|
||||
Private _Parent As Object
|
||||
Private _Name As String
|
||||
Private _Value As Variant
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CONSTRUCTORS / DESTRUCTORS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Sub Class_Initialize()
|
||||
_Type = OBJTEMPVAR
|
||||
Set _This = Nothing
|
||||
Set _Parent = Nothing
|
||||
_Name = ""
|
||||
_Value = Null
|
||||
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 Name() As String
|
||||
Name = _PropertyGet("Name")
|
||||
End Property ' Name (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get ObjectType() As String
|
||||
ObjectType = _PropertyGet("ObjectType")
|
||||
End Property ' ObjectType (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get Value() As Variant
|
||||
Value = _PropertyGet("Value")
|
||||
End Property ' Value (get)
|
||||
|
||||
Property Let Value(ByVal pvValue As Variant)
|
||||
Call _PropertySet("Value", pvValue)
|
||||
End Property ' Value (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS METHODS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
|
||||
' Return property value of psProperty property name
|
||||
|
||||
Utils._SetCalledSub("TempVar.getProperty")
|
||||
If IsMissing(pvProperty) Then Call _TraceArguments()
|
||||
getProperty = _PropertyGet(pvProperty)
|
||||
Utils._ResetCalledSub("TempVar.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 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 -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setProperty(ByVal Optional psProperty As String, ByVal Optional pvValue As Variant) As Boolean
|
||||
' Return True if property setting OK
|
||||
Utils._SetCalledSub("TempVar.getProperty")
|
||||
setProperty = _PropertySet(psProperty, pvValue)
|
||||
Utils._ResetCalledSub("TempVar.getProperty")
|
||||
End Function
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- PRIVATE FUNCTIONS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _PropertiesList() As Variant
|
||||
_PropertiesList = Array("Name", "ObjectType", "Value")
|
||||
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("TempVar.get" & psProperty)
|
||||
_PropertyGet = Nothing
|
||||
|
||||
Select Case UCase(psProperty)
|
||||
Case UCase("Name")
|
||||
_PropertyGet = _Name
|
||||
Case UCase("ObjectType")
|
||||
_PropertyGet = _Type
|
||||
Case UCase("Value")
|
||||
_PropertyGet = _Value
|
||||
Case Else
|
||||
Goto Trace_Error
|
||||
End Select
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub("TempVar.get" & psProperty)
|
||||
Exit Function
|
||||
Trace_Error:
|
||||
TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty)
|
||||
_PropertyGet = Nothing
|
||||
Goto Exit_Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, "TempVar._PropertyGet", Erl)
|
||||
_PropertyGet = Nothing
|
||||
GoTo Exit_Function
|
||||
End Function ' _PropertyGet
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Variant) As Boolean
|
||||
|
||||
Utils._SetCalledSub("TempVar.set" & psProperty)
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
_PropertySet = True
|
||||
|
||||
'Execute
|
||||
Dim iArgNr As Integer
|
||||
|
||||
If _IsLeft(_A2B_.CalledSub, "TempVar.") Then iArgNr = 1 Else iArgNr = 2
|
||||
Select Case UCase(psProperty)
|
||||
Case UCase("Value")
|
||||
_Value = pvValue
|
||||
_A2B_.TempVars.Item(UCase(_Name)).Value = pvValue
|
||||
Case Else
|
||||
Goto Trace_Error
|
||||
End Select
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub("TempVar.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, "TempVar._PropertySet", Erl)
|
||||
_PropertySet = False
|
||||
GoTo Exit_Function
|
||||
End Function ' _PropertySet
|
||||
|
||||
</script:module>
|
||||
@@ -0,0 +1,14 @@
|
||||
<?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="Test" script:language="StarBasic">Option Explicit
|
||||
'Option Compatible
|
||||
|
||||
Sub Main
|
||||
Dim a, b()
|
||||
_ErrorHandler(False)
|
||||
' DebugPrint vbLF
|
||||
' TraceConsole()
|
||||
exit sub
|
||||
End Sub
|
||||
|
||||
</script:module>
|
||||
438
office-plugin/windows-office/share/basic/Access2Base/Trace.xba
Normal file
438
office-plugin/windows-office/share/basic/Access2Base/Trace.xba
Normal file
@@ -0,0 +1,438 @@
|
||||
<?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="Trace" 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 Explicit
|
||||
|
||||
Public Const cstLogMaxEntries = 99
|
||||
|
||||
REM Typical Usage
|
||||
REM TraceLog("INFO", "The OK button was pressed")
|
||||
REM
|
||||
REM Typical Usage for error logging
|
||||
REM Sub MySub()
|
||||
REM On Local Error GoTo Error_Sub
|
||||
REM ...
|
||||
REM Exit_Sub:
|
||||
REM Exit Sub
|
||||
REM Error_Sub:
|
||||
REM TraceError("ERROR", Err, "MySub", Erl)
|
||||
REM GoTo Exit_Sub
|
||||
REM End Sub
|
||||
REM
|
||||
REM To display the current logged traces and/or to set parameters
|
||||
REM TraceConsole()
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Sub TraceConsole()
|
||||
' Display the Trace dialog with current trace log values and parameter choices
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Sub
|
||||
|
||||
Dim sLineBreak As String, oTraceDialog As Object
|
||||
sLineBreak = vbNewLine
|
||||
|
||||
Set oTraceDialog = CreateUnoDialog(Utils._GetDialogLib().dlgTrace)
|
||||
oTraceDialog.Title = _GetLabel("DLGTRACE_TITLE")
|
||||
oTraceDialog.Model.HelpText = _GetLabel("DLGTRACE_HELP")
|
||||
|
||||
Dim oEntries As Object, oTraceLog As Object, oClear As Object, oMinLevel As Object, oNbEntries As Object, oDump As Object
|
||||
Dim oControl As Object
|
||||
Dim i As Integer, sText As String, iOKCancel As Integer
|
||||
|
||||
Set oNbEntries = oTraceDialog.Model.getByName("numNbEntries")
|
||||
oNbEntries.Value = _A2B_.TraceLogCount
|
||||
oNbEntries.HelpText = _GetLabel("DLGTRACE_LBLNBENTRIES_HELP")
|
||||
|
||||
Set oControl = oTraceDialog.Model.getByName("lblNbEntries")
|
||||
oControl.Label = _GetLabel("DLGTRACE_LBLNBENTRIES_LABEL")
|
||||
oControl.HelpText = _GetLabel("DLGTRACE_LBLNBENTRIES_HELP")
|
||||
|
||||
Set oEntries = oTraceDialog.Model.getByName("numEntries")
|
||||
If _A2B_.TraceLogMaxEntries = 0 Then _A2B_.TraceLogMaxEntries = cstLogMaxEntries
|
||||
oEntries.Value = _A2B_.TraceLogMaxEntries
|
||||
oEntries.HelpText = _GetLabel("DLGTRACE_LBLENTRIES_HELP")
|
||||
|
||||
Set oControl = oTraceDialog.Model.getByName("lblEntries")
|
||||
oControl.Label = _GetLabel("DLGTRACE_LBLENTRIES_LABEL")
|
||||
oControl.HelpText = _GetLabel("DLGTRACE_LBLENTRIES_HELP")
|
||||
|
||||
Set oDump = oTraceDialog.Model.getByName("cmdDump")
|
||||
oDump.Enabled = 0
|
||||
oDump.Label = _GetLabel("DLGTRACE_CMDDUMP_LABEL")
|
||||
oDump.HelpText = _GetLabel("DLGTRACE_CMDDUMP_HELP")
|
||||
|
||||
Set oTraceLog = oTraceDialog.Model.getByName("txtTraceLog")
|
||||
oTraceLog.HelpText = _GetLabel("DLGTRACE_TXTTRACELOG_HELP")
|
||||
If UBound(_A2B_.TraceLogs) >= 0 Then ' Array yet initialized
|
||||
oTraceLog.HardLineBreaks = True
|
||||
sText = ""
|
||||
If _A2B_.TraceLogCount > 0 Then
|
||||
If _A2B_.TraceLogCount < _A2B_.TraceLogMaxEntries Then i = -1 Else i = _A2B_.TraceLogLast
|
||||
Do
|
||||
If i < _A2B_.TraceLogMaxEntries - 1 Then i = i + 1 Else i = 0
|
||||
If Len(_A2B_.TraceLogs(i)) > 11 Then
|
||||
sText = sText & Right(_A2B_.TraceLogs(i), Len(_A2B_.TraceLogs(i)) - 11) & sLineBreak ' Skip date in display
|
||||
End If
|
||||
Loop While i <> _A2B_.TraceLogLast
|
||||
oDump.Enabled = 1 ' Enable DumpToFile only if there is something to dump
|
||||
End If
|
||||
If Len(sText) > 0 Then sText = Left(sText, Len(sText) - Len(sLineBreak)) ' Skip last linefeed
|
||||
oTraceLog.Text = sText
|
||||
Else
|
||||
oTraceLog.Text = _GetLabel("DLGTRACE_TXTTRACELOG_TEXT")
|
||||
End If
|
||||
|
||||
Set oClear = oTraceDialog.Model.getByName("chkClear")
|
||||
oClear.State = 0 ' Unchecked
|
||||
oClear.HelpText = _GetLabel("DLGTRACE_LBLCLEAR_HELP")
|
||||
|
||||
Set oControl = oTraceDialog.Model.getByName("lblClear")
|
||||
oControl.Label = _GetLabel("DLGTRACE_LBLCLEAR_LABEL")
|
||||
oControl.HelpText = _GetLabel("DLGTRACE_LBLCLEAR_HELP")
|
||||
|
||||
Set oMinLevel = oTraceDialog.Model.getByName("cboMinLevel")
|
||||
If _A2B_.MinimalTraceLevel = 0 Then _A2B_.MinimalTraceLevel = _TraceLevel(TRACEERRORS)
|
||||
oMinLevel.Text = _TraceLevel(_A2B_.MinimalTraceLevel)
|
||||
oMinLevel.HelpText = _GetLabel("DLGTRACE_LBLMINLEVEL_HELP")
|
||||
|
||||
Set oControl = oTraceDialog.Model.getByName("lblMinLevel")
|
||||
oControl.Label = _GetLabel("DLGTRACE_LBLMINLEVEL_LABEL")
|
||||
oControl.HelpText = _GetLabel("DLGTRACE_LBLMINLEVEL_HELP")
|
||||
|
||||
Set oControl = oTraceDialog.Model.getByName("cmdOK")
|
||||
oControl.Label = _GetLabel("DLGTRACE_CMDOK_LABEL")
|
||||
oControl.HelpText = _GetLabel("DLGTRACE_CMDOK_HELP")
|
||||
|
||||
Set oControl = oTraceDialog.Model.getByName("cmdCancel")
|
||||
oControl.Label = _GetLabel("DLGTRACE_CMDCANCEL_LABEL")
|
||||
oControl.HelpText = _GetLabel("DLGTRACE_CMDCANCEL_HELP")
|
||||
|
||||
iOKCancel = oTraceDialog.Execute()
|
||||
|
||||
Select Case iOKCancel
|
||||
Case 1 ' OK
|
||||
If oClear.State = 1 Then
|
||||
_A2B_.TraceLogs() = Array() ' Erase logged traces
|
||||
_A2B_.TraceLogCount = 0
|
||||
End If
|
||||
If oMinLevel.Text <> "" Then _A2B_.MinimalTraceLevel = _TraceLevel(oMinLevel.Text)
|
||||
If oEntries.Value <> 0 And oEntries.Value <> _A2B_.TraceLogMaxEntries Then
|
||||
_A2B_.TraceLogs() = Array()
|
||||
_A2B_.TraceLogMaxEntries = oEntries.Value
|
||||
End If
|
||||
Case 0 ' Cancel
|
||||
Case Else
|
||||
End Select
|
||||
|
||||
Exit_Sub:
|
||||
If Not IsNull(oTraceDialog) Then oTraceDialog.Dispose()
|
||||
Exit Sub
|
||||
Error_Sub:
|
||||
With _A2B_
|
||||
.TraceLogs() = Array()
|
||||
.TraceLogCount = 0
|
||||
.TraceLogLast = 0
|
||||
End With
|
||||
GoTo Exit_Sub
|
||||
End Sub ' TraceConsole V1.1.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Sub TraceError(ByVal psErrorLevel As String _
|
||||
, ByVal piErrorCode As Integer _
|
||||
, ByVal psErrorProc As String _
|
||||
, ByVal piErrorLine As Integer _
|
||||
, ByVal Optional pvMsgBox As Variant _
|
||||
, ByVal Optional pvArgs As Variant _
|
||||
)
|
||||
' Store error code and description in trace rolling buffer
|
||||
' Display error message if errorlevel >= ERROR
|
||||
' Stop program execution if errorlevel = FATAL or ABORT
|
||||
|
||||
On Local Error Resume Next
|
||||
If IsEmpty(_A2B_) Then Call Application._RootInit() ' First use of Access2Base in current LibO/AOO session
|
||||
|
||||
Dim sErrorText As String, sErrorDesc As String, oDb As Object, bMsgBox As Boolean
|
||||
sErrorDesc = _ErrorMessage(piErrorCode, pvArgs)
|
||||
sErrorText = _GetLabel("ERR#") & CStr(piErrorCode) _
|
||||
& " (" & sErrorDesc & ") " & _GetLabel("ERROCCUR") _
|
||||
& Iif(piErrorLine > 0, " " & _GetLabel("ERRLINE") & " " & CStr(piErrorLine), "") _
|
||||
& Iif(psErrorProc <> "", " " & _GetLabel("ERRIN") & " " & psErrorProc, Iif(_A2B_.CalledSub = "", "", " " & _Getlabel("ERRIN") & " " & _A2B_.CalledSub))
|
||||
With _A2B_
|
||||
.LastErrorCode = piErrorCode
|
||||
.LastErrorLevel = psErrorLevel
|
||||
.ErrorText = sErrorDesc
|
||||
.ErrorLongText = sErrorText
|
||||
.CalledSub = ""
|
||||
End With
|
||||
If VarType(pvMsgBox) = vbError Then
|
||||
bMsgBox = ( psErrorLevel = TRACEERRORS Or psErrorLevel = TRACEFATAL Or psErrorLevel = TRACEABORT )
|
||||
ElseIf IsMissing(pvMsgBox) Then
|
||||
bMsgBox = ( psErrorLevel = TRACEERRORS Or psErrorLevel = TRACEFATAL Or psErrorLevel = TRACEABORT )
|
||||
Else
|
||||
bMsgBox = pvMsgBox
|
||||
End If
|
||||
TraceLog(psErrorLevel, sErrorText, bMsgBox)
|
||||
|
||||
' Unexpected error detected in user program or in Access2Base
|
||||
If psErrorLevel = TRACEFATAL Or psErrorLevel = TRACEABORT Then
|
||||
If psErrorLevel = TRACEFATAL Then
|
||||
Set oDb = _A2B_.CurrentDb()
|
||||
If Not IsNull(oDb) Then oDb.CloseAllrecordsets()
|
||||
End If
|
||||
Stop
|
||||
End If
|
||||
|
||||
End Sub ' TraceError V0.9.5
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function TraceErrorCode() As Variant
|
||||
' Return the last encountered error code, level, description in an array
|
||||
' UNPUBLISHED
|
||||
|
||||
Dim vError As Variant
|
||||
|
||||
With _A2B_
|
||||
vError = Array( _
|
||||
.LastErrorCode _
|
||||
, .LastErrorLevel _
|
||||
, .ErrorText _
|
||||
, .ErrorLongText _
|
||||
)
|
||||
End With
|
||||
TraceErrorCode = vError
|
||||
|
||||
End Function ' TraceErrorCode V6.3
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Sub TraceLevel(ByVal Optional psTraceLevel As String)
|
||||
' Set trace level to argument
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Sub
|
||||
Select Case True
|
||||
Case IsMissing(psTraceLevel) : psTraceLevel = "ERROR"
|
||||
Case psTraceLevel = "" : psTraceLevel = "ERROR"
|
||||
Case Utils._InList(UCase(psTraceLevel), Array( _
|
||||
TRACEDEBUG, TRACEINFO, TRACEWARNING, TRACEERRORS, TRACEFATAL, TRACEABORT _
|
||||
))
|
||||
Case Else : Goto Exit_Sub
|
||||
End Select
|
||||
_A2B_.MinimalTraceLevel = _TraceLevel(psTraceLevel)
|
||||
|
||||
Exit_Sub:
|
||||
Exit Sub
|
||||
Error_Sub:
|
||||
With _A2B_
|
||||
.TraceLogs() = Array()
|
||||
.TraceLogCount = 0
|
||||
.TraceLogLast = 0
|
||||
End With
|
||||
GoTo Exit_Sub
|
||||
End Sub ' TraceLevel V0.9.5
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Sub TraceLog(Byval psTraceLevel As String _
|
||||
, ByVal psText As String _
|
||||
, ByVal Optional pbMsgBox As Boolean _
|
||||
)
|
||||
' Store Text in trace log (circular buffer)
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Sub
|
||||
Dim vTraceLogs() As String, sTraceLevel As String
|
||||
|
||||
With _A2B_
|
||||
If .MinimalTraceLevel = 0 Then .MinimalTraceLevel = _TraceLevel(TRACEERRORS)
|
||||
If _TraceLevel(psTraceLevel) < .MinimalTraceLevel Then Exit Sub
|
||||
|
||||
If UBound(.TraceLogs) = -1 Then ' Initialize TraceLog
|
||||
If .TraceLogMaxEntries = 0 Then .TraceLogMaxEntries = cstLogMaxEntries
|
||||
|
||||
Redim vTraceLogs(0 To .TraceLogMaxEntries - 1)
|
||||
.TraceLogs = vTraceLogs
|
||||
.TraceLogCount = 0
|
||||
.TraceLogLast = -1
|
||||
If .MinimalTraceLevel = 0 Then .MinimalTraceLevel = _TraceLevel(TRACEERRORS) ' Set default value
|
||||
End If
|
||||
|
||||
.TraceLogLast = .TraceLogLast + 1
|
||||
If .TraceLogLast > UBound(.TraceLogs) Then .TraceLogLast = LBound(.TraceLogs) ' Circular buffer
|
||||
If Len(psTraceLevel) > 7 Then sTraceLevel = Left(psTraceLevel, 7) Else sTraceLevel = psTraceLevel & Spc(8 - Len(psTraceLevel))
|
||||
.TraceLogs(.TraceLogLast) = Format(Now(), "YYYY-MM-DD hh:mm:ss") & " " & sTraceLevel & psText
|
||||
If .TraceLogCount <= UBound(.TraceLogs) Then .TraceLogCount = .TraceLogCount + 1 ' # of active entries
|
||||
End With
|
||||
|
||||
If IsMissing(pbMsgBox) Then pbMsgBox = True
|
||||
Dim iMsgBox As Integer
|
||||
If pbMsgBox Then
|
||||
Select Case psTraceLevel
|
||||
Case TRACEINFO: iMsgBox = vbInformation
|
||||
Case TRACEERRORS, TRACEWARNING: iMsgBox = vbExclamation
|
||||
Case TRACEFATAL, TRACEABORT: iMsgBox = vbCritical
|
||||
Case Else: iMsgBox = vbInformation
|
||||
End Select
|
||||
MsgBox psText, vbOKOnly + iMsgBox, psTraceLevel
|
||||
End If
|
||||
|
||||
Exit_Sub:
|
||||
Exit Sub
|
||||
Error_Sub:
|
||||
With _A2B_
|
||||
.TraceLogs() = Array()
|
||||
.TraceLogCount = 0
|
||||
.TraceLogLast = 0
|
||||
End With
|
||||
GoTo Exit_Sub
|
||||
End Sub ' TraceLog V0.9.5
|
||||
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- PRIVATE FUNCTIONS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
Private Sub _DumpToFile(oEvent As Object)
|
||||
' Execute the Dump To File command from the Trace dialog
|
||||
' Modified from Andrew Pitonyak's Base Macro Programming §10.4
|
||||
|
||||
|
||||
If _ErrorHandler() Then On Local Error GoTo Error_Sub
|
||||
|
||||
Dim sPath as String, iFileNumber As Integer, i As Integer
|
||||
|
||||
sPath = _PromptFilePicker("txt")
|
||||
If sPath <> "" Then ' Save button pressed
|
||||
If UBound(_A2B_.TraceLogs) >= 0 Then ' Array yet initialized
|
||||
iFileNumber = FreeFile()
|
||||
Open sPath For Append Access Write Lock Read As iFileNumber
|
||||
If _A2B_.TraceLogCount > 0 Then
|
||||
If _A2B_.TraceLogCount < _A2B_.TraceLogMaxEntries Then i = -1 Else i = _A2B_.TraceLogLast
|
||||
Do
|
||||
If i < _A2B_.TraceLogMaxEntries - 1 Then i = i + 1 Else i = 0
|
||||
Print #iFileNumber _A2B_.TraceLogs(i)
|
||||
Loop While i <> _A2B_.TraceLogLast
|
||||
End If
|
||||
Close iFileNumber
|
||||
MsgBox _GetLabel("SAVECONSOLEENTRIES"), vbOK + vbInformation, _GetLabel("SAVECONSOLE")
|
||||
End If
|
||||
End If
|
||||
|
||||
Exit_Sub:
|
||||
Exit Sub
|
||||
Error_Sub:
|
||||
TraceError("ERROR", Err, "DumpToFile", Erl)
|
||||
GoTo Exit_Sub
|
||||
End Sub ' DumpToFile V0.8.5
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function _ErrorHandler(Optional ByVal pbCheck As Boolean) As Boolean
|
||||
' Indicate if error handler is activated or not
|
||||
' When argument present set error handler
|
||||
If IsEmpty(_A2B_) Then Call Application._RootInit() ' First use of Access2Base in current LibO/AOO session
|
||||
If Not IsMissing(pbCheck) Then _A2B_.ErrorHandler = pbCheck
|
||||
_ErrorHandler = _A2B_.ErrorHandler
|
||||
Exit Function
|
||||
End Function
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _ErrorMessage(ByVal piErrorNumber As Integer, Optional ByVal pvArgs As Variant) As String
|
||||
' Return error message corresponding to ErrorNumber (standard or not)
|
||||
' and replaces %0, %1, ... , %9 by psArgs(0), psArgs(1), ...
|
||||
|
||||
Dim sErrorMessage As String, i As Integer, sErrLabel
|
||||
_ErrorMessage = ""
|
||||
If piErrorNumber > ERRINIT Then
|
||||
sErrLabel = "ERR" & piErrorNumber
|
||||
sErrorMessage = _Getlabel(sErrLabel)
|
||||
If Not IsMissing(pvArgs) Then
|
||||
If Not IsArray(pvArgs) Then
|
||||
sErrorMessage = Join(Split(sErrorMessage, "%0"), Utils._CStr(pvArgs, False))
|
||||
Else
|
||||
For i = LBound(pvArgs) To UBound(pvArgs)
|
||||
sErrorMessage = Join(Split(sErrorMessage, "%" & i), Utils._CStr(pvArgs(i), False))
|
||||
Next i
|
||||
End If
|
||||
End If
|
||||
Else
|
||||
sErrorMessage = Error(piErrorNumber)
|
||||
' Most (or all?) error messages terminate with a "."
|
||||
If Len(sErrorMessage) > 1 And Right(sErrorMessage, 1) = "." Then sErrorMessage = Left(sErrorMessage, Len(sErrorMessage)-1)
|
||||
End If
|
||||
|
||||
_ErrorMessage = sErrorMessage
|
||||
Exit Function
|
||||
|
||||
End Function ' ErrorMessage V0.8.9
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function _PromptFilePicker(ByVal psSuffix As String) As String
|
||||
' Prompt for output file name
|
||||
' Return "" if Cancel
|
||||
' Modified from Andrew Pitonyak's Base Macro Programming §10.4
|
||||
|
||||
If _ErrorHandler() Then On Local Error GoTo Error_Function
|
||||
|
||||
Dim oFileDialog as Object, oUcb as object, oPath As Object
|
||||
Dim iAccept as Integer, sInitPath as String
|
||||
|
||||
Set oFileDialog = CreateUnoService("com.sun.star.ui.dialogs.FilePicker")
|
||||
oFileDialog.Initialize(Array(com.sun.star.ui.dialogs.TemplateDescription.FILESAVE_AUTOEXTENSION))
|
||||
Set oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess")
|
||||
|
||||
oFileDialog.appendFilter("*." & psSuffix, "*." & psSuffix)
|
||||
oFileDialog.appendFilter("*.*", "*.*")
|
||||
oFileDialog.setCurrentFilter("*." & psSuffix)
|
||||
Set oPath = createUnoService("com.sun.star.util.PathSettings")
|
||||
sInitPath = oPath.Work ' Probably My Documents
|
||||
If oUcb.Exists(sInitPath) Then oFileDialog.SetDisplayDirectory(sInitPath)
|
||||
|
||||
iAccept = oFileDialog.Execute()
|
||||
|
||||
_PromptFilePicker = ""
|
||||
If iAccept = 1 Then ' Save button pressed
|
||||
_PromptFilePicker = oFileDialog.Files(0)
|
||||
End If
|
||||
|
||||
Exit_Function:
|
||||
If Not IsEmpty(oFileDialog) And Not IsNull(oFileDialog) Then oFileDialog.Dispose()
|
||||
Exit Function
|
||||
Error_Function:
|
||||
TraceError("ERROR", Err, "PromptFilePicker", Erl)
|
||||
GoTo Exit_Function
|
||||
End Function ' PromptFilePicker V0.8.5
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Sub _TraceArguments(Optional psCall As String)
|
||||
' Process the ERRMISSINGARGUMENTS error
|
||||
' psCall is present if error detected before call to _SetCalledSub
|
||||
|
||||
If Not IsMissing(psCall) Then Utils._SetCalledSub(psCall)
|
||||
TraceError(TRACEFATAL, ERRMISSINGARGUMENTS, Utils._CalledSub(), 0)
|
||||
Exit Sub
|
||||
|
||||
End Sub ' TraceArguments
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _TraceLevel(ByVal pvTraceLevel As Variant) As Variant
|
||||
' Convert string trace level to numeric value or the opposite
|
||||
|
||||
Dim vTraces As Variant, i As Integer
|
||||
vTraces = Array(TRACEDEBUG, TRACEINFO, TRACEWARNING, TRACEERRORS, TRACEFATAL, TRACEABORT, TRACEANY)
|
||||
|
||||
Select Case VarType(pvTraceLevel)
|
||||
Case vbString
|
||||
_TraceLevel = 4 ' 4 = Default
|
||||
For i = 0 To UBound(vTraces)
|
||||
If UCase(pvTraceLevel) = UCase(vTraces(i)) Then
|
||||
_TraceLevel = i + 1
|
||||
Exit For
|
||||
End If
|
||||
Next i
|
||||
Case vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbBigint, vbDecimal
|
||||
If pvTraceLevel < 1 Or pvTraceLevel > UBound(vTraces) + 1 Then _TraceLevel = TRACEERRORS Else _TraceLevel = vTraces(pvTraceLevel - 1)
|
||||
End Select
|
||||
|
||||
End Function ' TraceLevel
|
||||
|
||||
</script:module>
|
||||
@@ -0,0 +1,331 @@
|
||||
<?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="UtilProperty" 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 =======================================================================================================================
|
||||
|
||||
'**********************************************************************
|
||||
' UtilProperty module
|
||||
'
|
||||
' Module of utilities to manipulate arrays of PropertyValue's.
|
||||
'**********************************************************************
|
||||
|
||||
'**********************************************************************
|
||||
' Copyright (c) 2003-2004 Danny Brewer
|
||||
' d29583@groovegarden.com
|
||||
'**********************************************************************
|
||||
|
||||
'**********************************************************************
|
||||
' If you make changes, please append to the change log below.
|
||||
'
|
||||
' Change Log
|
||||
' Danny Brewer Revised 2004-02-25-01
|
||||
' Jean-Pierre Ledure Adapted to Access2Base coding conventions
|
||||
' PropValuesToStr rewritten and addition of StrToPropValues
|
||||
' Bug corrected on date values
|
||||
' Addition of support of 2-dimensional arrays
|
||||
' Support of empty arrays to allow JSON conversions
|
||||
'**********************************************************************
|
||||
|
||||
Option Explicit
|
||||
|
||||
Private Const cstHEADER = "### PROPERTYVALUES ###"
|
||||
Private Const cstEMPTYARRAY = "### EMPTY ARRAY ###"
|
||||
|
||||
REM =======================================================================================================================
|
||||
Public Function _MakePropertyValue(ByVal Optional psName As String, Optional pvValue As Variant) As com.sun.star.beans.PropertyValue
|
||||
' Create and return a new com.sun.star.beans.PropertyValue.
|
||||
|
||||
Dim oPropertyValue As New com.sun.star.beans.PropertyValue
|
||||
|
||||
If Not IsMissing(psName) Then oPropertyValue.Name = psName
|
||||
If Not IsMissing(pvValue) Then oPropertyValue.Value = _CheckPropertyValue(pvValue)
|
||||
_MakePropertyValue() = oPropertyValue
|
||||
|
||||
End Function ' _MakePropertyValue V1.3.0
|
||||
|
||||
REM =======================================================================================================================
|
||||
Public Function _CheckPropertyValue(ByRef pvValue As Variant) As Variant
|
||||
' Date BASIC variables give error. Change them to strings
|
||||
' Empty arrays should be replaced by cstEMPTYARRAY
|
||||
|
||||
If VarType(pvValue) = vbDate Then
|
||||
_CheckPropertyValue = Utils._CStr(pvValue, False)
|
||||
ElseIf IsArray(pvValue) Then
|
||||
If UBound(pvValue, 1) < LBound(pvValue, 1) Then _CheckPropertyValue = cstEMPTYARRAY Else _CheckPropertyValue = pvValue
|
||||
Else
|
||||
_CheckPropertyValue = pvValue
|
||||
End If
|
||||
|
||||
End Function ' _CheckPropertyValue
|
||||
|
||||
REM =======================================================================================================================
|
||||
Public Function _NumPropertyValues(ByRef pvPropertyValuesArray As Variant) As Integer
|
||||
' Return the number of PropertyValue's in an array.
|
||||
' Parameters:
|
||||
' pvPropertyValuesArray - an array of PropertyValue's, that is an array of com.sun.star.beans.PropertyValue.
|
||||
' Returns zero if the array contains no elements.
|
||||
|
||||
Dim iNumProperties As Integer
|
||||
If Not IsArray(pvPropertyValuesArray) Then iNumProperties = 0 Else iNumProperties = UBound(pvPropertyValuesArray) + 1
|
||||
_NumPropertyValues() = iNumProperties
|
||||
|
||||
End Function ' _NumPropertyValues V1.3.0
|
||||
|
||||
REM =======================================================================================================================
|
||||
Public Function _FindPropertyIndex(ByRef pvPropertyValuesArray As Variant, ByVal psPropName As String ) As Integer
|
||||
' Find a particular named property from an array of PropertyValue's.
|
||||
' Finds the index in the array of PropertyValue's and returns it, or returns -1 if it was not found.
|
||||
|
||||
Dim iNumProperties As Integer, i As Integer, vProp As Variant
|
||||
iNumProperties = _NumPropertyValues(pvPropertyValuesArray)
|
||||
For i = 0 To iNumProperties - 1
|
||||
vProp = pvPropertyValuesArray(i)
|
||||
If UCase(vProp.Name) = UCase(psPropName) Then
|
||||
_FindPropertyIndex() = i
|
||||
Exit Function
|
||||
EndIf
|
||||
Next i
|
||||
_FindPropertyIndex() = -1
|
||||
|
||||
End Function ' _FindPropertyIndex V1.3.0
|
||||
|
||||
REM =======================================================================================================================
|
||||
Public Function _FindProperty(ByRef pvPropertyValuesArray As Variant, ByVal psPropName As String) As com.sun.star.beans.PropertyValue
|
||||
' Find a particular named property from an array of PropertyValue's.
|
||||
' Finds the PropertyValue and returns it, or returns Null if not found.
|
||||
|
||||
Dim iPropIndex As Integer, vProp As Variant
|
||||
iPropIndex = _FindPropertyIndex(pvPropertyValuesArray, psPropName)
|
||||
If iPropIndex >= 0 Then
|
||||
vProp = pvPropertyValuesArray(iPropIndex) ' access array subscript
|
||||
_FindProperty() = vProp
|
||||
EndIf
|
||||
|
||||
End Function ' _FindProperty V1.3.0
|
||||
|
||||
REM =======================================================================================================================
|
||||
Public Function _GetPropertyValue(ByRef pvPropertyValuesArray As Variant, ByVal psPropName As String, Optional pvDefaultValue) As Variant
|
||||
' Get the value of a particular named property from an array of PropertyValue's.
|
||||
' vDefaultValue - This value is returned if the property is not found in the array.
|
||||
|
||||
Dim iPropIndex As Integer, vProp As Variant, vValue As Variant, vMatrix As Variant, i As Integer, j As Integer
|
||||
iPropIndex = _FindPropertyIndex(pvPropertyValuesArray, psPropName)
|
||||
If iPropIndex >= 0 Then
|
||||
vProp = pvPropertyValuesArray(iPropIndex) ' access array subscript
|
||||
vValue = vProp.Value ' get the value from the PropertyValue
|
||||
If VarType(vValue) = vbString Then
|
||||
If vValue = cstEMPTYARRAY Then _GetPropertyValue() = Array() Else _GetPropertyValue() = vValue
|
||||
ElseIf IsArray(vValue) Then
|
||||
If IsArray(vValue(0)) Then ' Array of arrays
|
||||
vMatrix = Array()
|
||||
ReDim vMatrix(0 To UBound(vValue), 0 To UBound(vValue(0)))
|
||||
For i = 0 To UBound(vValue)
|
||||
For j = 0 To UBound(vValue(0))
|
||||
vMatrix(i, j) = vValue(i)(j)
|
||||
Next j
|
||||
Next i
|
||||
_GetPropertyValue() = vMatrix
|
||||
Else
|
||||
_GetPropertyValue() = vValue ' Simple vector OK
|
||||
End If
|
||||
Else
|
||||
_GetPropertyValue() = vValue
|
||||
End If
|
||||
Else
|
||||
If IsMissing(pvDefaultValue) Then pvDefaultValue = Null
|
||||
_GetPropertyValue() = pvDefaultValue
|
||||
EndIf
|
||||
|
||||
End Function ' _GetPropertyValue V1.3.0
|
||||
|
||||
REM =======================================================================================================================
|
||||
Public Sub _SetPropertyValue(ByRef pvPropertyValuesArray As Variant, ByVal psPropName As String, ByVal pvValue As Variant)
|
||||
' Set the value of a particular named property from an array of PropertyValue's.
|
||||
|
||||
Dim iPropIndex As Integer, vProp As Variant, iNumProperties As Integer
|
||||
|
||||
iPropIndex = _FindPropertyIndex(pvPropertyValuesArray, psPropName)
|
||||
If iPropIndex >= 0 Then
|
||||
' Found, the PropertyValue is already in the array. Just modify its value.
|
||||
vProp = pvPropertyValuesArray(iPropIndex) ' access array subscript
|
||||
vProp.Value = _CheckPropertyValue(pvValue) ' set the property value.
|
||||
pvPropertyValuesArray(iPropIndex) = vProp ' put it back into array
|
||||
Else
|
||||
' Not found, the array contains no PropertyValue with this name. Append new element to array.
|
||||
iNumProperties = _NumPropertyValues(pvPropertyValuesArray)
|
||||
If iNumProperties = 0 Then
|
||||
pvPropertyValuesArray = Array(_MakePropertyValue(psPropName, pvValue))
|
||||
Else
|
||||
' Make array larger.
|
||||
Redim Preserve pvPropertyValuesArray(iNumProperties)
|
||||
' Assign new PropertyValue
|
||||
pvPropertyValuesArray(iNumProperties) = _MakePropertyValue(psPropName, pvValue)
|
||||
EndIf
|
||||
EndIf
|
||||
|
||||
End Sub ' _SetPropertyValue V1.3.0
|
||||
|
||||
REM =======================================================================================================================
|
||||
Public Sub _DeleteProperty(ByRef pvPropertyValuesArray As Variant, ByVal psPropName As String)
|
||||
' Delete a particular named property from an array of PropertyValue's.
|
||||
|
||||
Dim iPropIndex As Integer
|
||||
iPropIndex = _FindPropertyIndex(pvPropertyValuesArray, psPropName)
|
||||
If iPropIndex >= 0 Then _DeleteIndexedProperty(pvPropertyValuesArray, iPropIndex)
|
||||
|
||||
End Sub ' _DeletePropertyValue V1.3.0
|
||||
|
||||
REM =======================================================================================================================
|
||||
Public Sub _DeleteIndexedProperty(ByRef pvPropertyValuesArray As Variant, ByVal piPropIndex As Integer)
|
||||
' Delete a particular indexed property from an array of PropertyValue's.
|
||||
|
||||
Dim iNumProperties As Integer, i As Integer
|
||||
iNumProperties = _NumPropertyValues(pvPropertyValuesArray)
|
||||
|
||||
' Did we find it?
|
||||
If piPropIndex < 0 Then
|
||||
' Do nothing
|
||||
ElseIf iNumProperties = 1 Then
|
||||
' Just return a new empty array
|
||||
pvPropertyValuesArray = Array()
|
||||
Else
|
||||
' If it is NOT the last item in the array, then shift other elements down into it's position.
|
||||
If piPropIndex < iNumProperties - 1 Then
|
||||
' Bump items down lower in the array.
|
||||
For i = piPropIndex To iNumProperties - 2
|
||||
pvPropertyValuesArray(i) = pvPropertyValuesArray(i + 1)
|
||||
Next i
|
||||
EndIf
|
||||
' Redimension the array to have one fewer element.
|
||||
Redim Preserve pvPropertyValuesArray(iNumProperties - 2)
|
||||
EndIf
|
||||
|
||||
End Sub ' _DeleteIndexedProperty V1.3.0
|
||||
|
||||
REM =======================================================================================================================
|
||||
Public Function _PropValuesToStr(ByRef pvPropertyValuesArray As Variant) As String
|
||||
' Return a string with dumped content of the array of PropertyValue's.
|
||||
' SYNTAX:
|
||||
' NameOfProperty = This is a string (or 12 or 2016-12-31 12:05 or 123.45 or -0.12E-05 ...)
|
||||
' NameOfArray = (10)
|
||||
' 1;2;3;4;5;6;7;8;9;10
|
||||
' NameOfMatrix = (2,10)
|
||||
' 1;2;3;4;5;6;7;8;9;10
|
||||
' A;B;C;D;E;F;G;H;I;J
|
||||
' Semicolons and backslashes are escaped with a backslash (see _CStr and _CVar functions)
|
||||
|
||||
Dim iNumProperties As Integer, sResult As String, i As Integer, j As Integer, vProp As Variant
|
||||
Dim sName As String, vValue As Variant, iType As Integer
|
||||
Dim cstLF As String
|
||||
|
||||
cstLF = vbLf()
|
||||
iNumProperties = _NumPropertyValues(pvPropertyValuesArray)
|
||||
|
||||
sResult = cstHEADER & cstLF
|
||||
For i = 0 To iNumProperties - 1
|
||||
vProp = pvPropertyValuesArray(i)
|
||||
sName = vProp.Name
|
||||
vValue = vProp.Value
|
||||
iType = VarType(vValue)
|
||||
Select Case iType
|
||||
Case < vbArray ' Scalar
|
||||
sResult = sResult & sName & " = " & Utils._CStr(vValue, False) & cstLF
|
||||
Case Else ' Vector or matrix
|
||||
If uBound(vValue, 1) < 0 Then
|
||||
sResult = sResult & sName & " = (0)" & cstLF
|
||||
' 1-dimension but vector of vectors must also be considered
|
||||
ElseIf VarType(vValue(0)) >= vbArray Then
|
||||
sResult = sResult & sName & " = (" & UBound(vValue) + 1 & "," & UBound(vValue(0)) + 1 & ")" & cstLF
|
||||
For j = 0 To UBound(vValue)
|
||||
sResult = sResult & Utils._CStr(vValue(j), False) & cstLF
|
||||
Next j
|
||||
Else
|
||||
sResult = sResult & sName & " = (" & UBound(vValue, 1) + 1 & ")" & cstLF
|
||||
sResult = sResult & Utils._CStr(vValue, False) & cstLF
|
||||
End If
|
||||
End Select
|
||||
Next i
|
||||
|
||||
_PropValuesToStr() = Left(sResult, Len(sResult) - 1) ' Remove last LF
|
||||
|
||||
End Function ' _PropValuesToStr V1.3.0
|
||||
|
||||
REM =======================================================================================================================
|
||||
Public Function _StrToPropValues(psString) As Variant
|
||||
' Return an array of PropertyValue's rebuilt from the string parameter
|
||||
|
||||
Dim vString() As Variant, i As Integer,iArray As Integer, iRows As Integer, iCols As Integer
|
||||
Dim lPosition As Long, sName As String, vValue As Variant, vResult As Variant, sDim As String
|
||||
Dim lSearch As Long
|
||||
Dim cstLF As String
|
||||
Const cstEqualArray = " = (", cstEqual = " = "
|
||||
|
||||
cstLF = Chr(10)
|
||||
_StrToPropValues = Array()
|
||||
vResult = Array()
|
||||
|
||||
If psString = "" Then Exit Function
|
||||
vString = Split(psString, cstLF)
|
||||
If UBound(vString) <= 0 Then Exit Function ' There must be at least one name-value pair
|
||||
If vString(0) <> cstHEADER Then Exit Function ' Check origin
|
||||
|
||||
iArray = -1
|
||||
For i = 1 To UBound(vString)
|
||||
If vString(i) <> "" Then ' Skip empty lines
|
||||
If iArray < 0 Then ' Not busy with array row
|
||||
lPosition = 1
|
||||
sName = Utils._RegexSearch(vString(i), "^\b\w+\b", lPosition) ' Identifier
|
||||
If sName = "" Then Exit Function
|
||||
If InStr(vString(i), cstEqualArray) = lPosition + Len(sName) Then ' Start array processing
|
||||
lSearch = lPosition + Len(sName) + Len(cstEqualArray) - 1
|
||||
sDim = Utils._RegexSearch(vString(i), "\([0-9]+\)", lSearch) ' e.g. (10)
|
||||
If sDim = "(0)" Then ' Empty array
|
||||
iRows = -1
|
||||
vValue = Array()
|
||||
_SetPropertyValue(vResult, sName, vValue)
|
||||
ElseIf sDim <> "" Then ' Vector with content
|
||||
iCols = CInt(Mid(sDim, 2, Len(sDim) - 2))
|
||||
iRows = 0
|
||||
ReDim vValue(0 To iCols - 1)
|
||||
iArray = 0
|
||||
Else ' Matrix with content
|
||||
lSearch = lPosition + Len(sName) + Len(cstEqualArray) - 1
|
||||
sDim = Utils._RegexSearch(vString(i), "\([0-9]+,", lSearch) ' e.g. (10,
|
||||
iRows = CInt(Mid(sDim, 2, Len(sDim) - 2))
|
||||
sDim = Utils._RegexSearch(vString(i), ",[0-9]+\)", lSearch) ' e.g. ,20)
|
||||
iCols = CInt(Mid(sDim, 2, Len(sDim) - 2))
|
||||
ReDim vValue(0 To iRows - 1)
|
||||
iArray = 0
|
||||
End If
|
||||
ElseIf InStr(vString(i), cstEqual) = lPosition + Len(sName) Then
|
||||
vValue = Utils._CVar(Mid(vString(i), Len(sName) + Len(cstEqual) + 1))
|
||||
_SetPropertyValue(vResult, sName, vValue)
|
||||
Else
|
||||
Exit Function
|
||||
End If
|
||||
Else ' Line is an array row
|
||||
If iRows = 0 Then
|
||||
vValue = Utils._CVar(vString(i), True) ' Keep dates as strings
|
||||
iArray = -1
|
||||
_SetPropertyValue(vResult, sName, vValue)
|
||||
Else
|
||||
vValue(iArray) = Utils._CVar(vString(i), True)
|
||||
If iArray < iRows - 1 Then
|
||||
iArray = iArray + 1
|
||||
Else
|
||||
iArray = -1
|
||||
_SetPropertyValue(vResult, sName, vValue)
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
Next i
|
||||
|
||||
_StrToPropValues = vResult
|
||||
|
||||
End Function
|
||||
|
||||
</script:module>
|
||||
1308
office-plugin/windows-office/share/basic/Access2Base/Utils.xba
Normal file
1308
office-plugin/windows-office/share/basic/Access2Base/Utils.xba
Normal file
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,25 @@
|
||||
<?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="_License" script:language="StarBasic">
|
||||
' Copyright 2012-2017 Jean-Pierre LEDURE
|
||||
|
||||
REM =======================================================================================================================
|
||||
REM === The Access2Base library is a part of the LibreOffice project. ===
|
||||
REM === Full documentation is available on http://www.access2base.com ===
|
||||
REM =======================================================================================================================
|
||||
|
||||
' Access2Base is distributed in the hope that it will be useful,
|
||||
' but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||
|
||||
' Access2Base is free software; you can redistribute it and/or modify it under the terms of either (at your option):
|
||||
'
|
||||
' 1) The Mozilla Public License, v. 2.0. If a copy of the MPL was not
|
||||
' distributed with this file, you can obtain one at http://mozilla.org/MPL/2.0/ .
|
||||
'
|
||||
' 2) The GNU Lesser General Public License as published by
|
||||
' the Free Software Foundation, either version 3 of the License, or
|
||||
' (at your option) any later version. If a copy of the LGPL was not
|
||||
' distributed with this file, see http://www.gnu.org/licenses/ .
|
||||
|
||||
</script:module>
|
||||
@@ -0,0 +1,395 @@
|
||||
<?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="acConstants" 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 Explicit
|
||||
|
||||
REM Access2Base -----------------------------------------------------
|
||||
Global Const Access2Base_Version = "7.1.0" ' Alignment on LibreOffice versions
|
||||
|
||||
REM AcCloseSave
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const acSaveNo = 2
|
||||
Global Const acSavePrompt = 0
|
||||
Global Const acSaveYes = 1
|
||||
|
||||
REM AcFormView
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const acDesign = 1
|
||||
Global Const acNormal = 0
|
||||
Global Const acPreview = 2
|
||||
|
||||
REM AcFormOpenDataMode
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const acFormAdd = 0
|
||||
Global Const acFormEdit = 1
|
||||
Global Const acFormPropertySettings = -1
|
||||
Global Const acFormReadOnly = 2
|
||||
|
||||
REM acView
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const acViewDesign = 1
|
||||
Global Const acViewNormal = 0
|
||||
Global Const acViewPreview = 2
|
||||
|
||||
REM acOpenDataMode
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const acAdd = 0
|
||||
Global Const acEdit = 1
|
||||
Global Const acReadOnly = 2
|
||||
|
||||
REM AcObjectType
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const acDefault = -1
|
||||
Global Const acDiagram = 8
|
||||
Global Const acForm = 2
|
||||
Global Const acQuery = 1
|
||||
Global Const acReport = 3
|
||||
Global Const acTable = 0
|
||||
' Unexisting in MS/Access
|
||||
Global Const acBasicIDE = 101
|
||||
Global Const acDatabaseWindow = 102
|
||||
Global Const acDocument = 111
|
||||
Global Const acWelcome = 112
|
||||
' Subtype if acDocument
|
||||
Global Const docWriter = "Writer"
|
||||
Global Const docCalc = "Calc"
|
||||
Global Const docImpress = "Impress"
|
||||
Global Const docDraw = "Draw"
|
||||
Global Const docMath = "Math"
|
||||
|
||||
REM AcWindowMode
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const acDialog = 3
|
||||
Global Const acHidden = 1
|
||||
Global Const acIcon = 2
|
||||
Global Const acWindowNormal = 0
|
||||
|
||||
REM VarType constants
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const vbEmpty = 0
|
||||
Global Const vbNull = 1
|
||||
Global Const vbInteger = 2
|
||||
Global Const vbLong = 3
|
||||
Global Const vbSingle = 4
|
||||
Global Const vbDouble = 5
|
||||
Global Const vbCurrency = 6
|
||||
Global Const vbDate = 7
|
||||
Global Const vbString = 8
|
||||
Global Const vbObject = 9
|
||||
Global Const vbError = 10
|
||||
Global Const vbBoolean = 11
|
||||
Global Const vbVariant = 12
|
||||
Global Const vbByte = 17
|
||||
Global Const vbUShort = 18
|
||||
Global Const vbULong = 19
|
||||
Global Const vbBigint = 35
|
||||
Global Const vbDecimal = 37
|
||||
Global Const vbArray = 8192
|
||||
|
||||
REM MsgBox constants
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const vbOKOnly = 0 ' OK button only (default)
|
||||
Global Const vbOKCancel = 1 ' OK and Cancel buttons
|
||||
Global Const vbAbortRetryIgnore = 2 ' Abort, Retry, and Ignore buttons
|
||||
Global Const vbYesNoCancel = 3 ' Yes, No, and Cancel buttons
|
||||
Global Const vbYesNo = 4 ' Yes and No buttons
|
||||
Global Const vbRetryCancel = 5 ' Retry and Cancel buttons
|
||||
Global Const vbCritical = 16 ' Critical message
|
||||
Global Const vbQuestion = 32 ' Warning query
|
||||
Global Const vbExclamation = 48 ' Warning message
|
||||
Global Const vbInformation = 64 ' Information message
|
||||
Global Const vbDefaultButton1 = 128 ' First button is default (default) (VBA: 0)
|
||||
Global Const vbDefaultButton2 = 256 ' Second button is default
|
||||
Global Const vbDefaultButton3 = 512 ' Third button is default
|
||||
Global Const vbApplicationModal = 0 ' Application modal message box (default)
|
||||
REM MsgBox Return Values
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const vbOK = 1 ' OK button pressed
|
||||
Global Const vbCancel = 2 ' Cancel button pressed
|
||||
Global Const vbAbort = 3 ' Abort button pressed
|
||||
Global Const vbRetry = 4 ' Retry button pressed
|
||||
Global Const vbIgnore = 5 ' Ignore button pressed
|
||||
Global Const vbYes = 6 ' Yes button pressed
|
||||
Global Const vbNo = 7 ' No button pressed
|
||||
|
||||
REM Dialogs Return Values
|
||||
REM ------------------------------------------------------------------
|
||||
Global Const dlgOK = 1 ' OK button pressed
|
||||
Global Const dlgCancel = 0 ' Cancel button pressed
|
||||
|
||||
REM Control Types
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const acCheckBox = 5
|
||||
Global Const acComboBox = 7
|
||||
Global Const acCommandButton = 2 : Global Const acToggleButton = 122
|
||||
Global Const acCurrencyField = 18
|
||||
Global Const acDateField = 15
|
||||
Global Const acFileControl = 12
|
||||
Global Const acFixedLine = 24 ' FREE ENTRY (USEFUL IN DIALOGS)
|
||||
Global Const acFixedText = 10 : Global Const acLabel = 10
|
||||
Global Const acFormattedField = 1 ' FREE ENTRY TAKEN TO NOT CONFUSE WITH acTextField
|
||||
Global Const acGridControl = 11
|
||||
Global Const acGroupBox = 8 : Global Const acOptionGroup = 8
|
||||
Global Const acHiddenControl = 13
|
||||
Global Const acImageButton = 4
|
||||
Global Const acImageControl = 14 : Global Const acImage = 14
|
||||
Global Const acListBox = 6
|
||||
Global Const acNavigationBar = 22
|
||||
Global Const acNumericField = 17
|
||||
Global Const acPatternField = 19
|
||||
Global Const acProgressBar = 23 ' FREE ENTRY (USEFUL IN DIALOGS)
|
||||
Global Const acRadioButton = 3 : Global Const acOptionButton = 3
|
||||
Global Const acScrollBar = 20
|
||||
Global Const acSpinButton = 21
|
||||
Global Const acSubform = 112
|
||||
Global Const acTextField = 9 : Global Const acTextBox = 9
|
||||
Global Const acTimeField = 16
|
||||
|
||||
REM AcRecord
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const acFirst = 2
|
||||
Global Const acGoTo = 4
|
||||
Global Const acLast = 3
|
||||
Global Const acNewRec = 5
|
||||
Global Const acNext = 1
|
||||
Global Const acPrevious = 0
|
||||
|
||||
REM FindRecord
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const acAnywhere = 0
|
||||
Global Const acEntire = 1
|
||||
Global Const acStart = 2
|
||||
Global Const acDown = 1
|
||||
Global Const acSearchAll = 2
|
||||
Global Const acUp = 0
|
||||
Global Const acAll = 0
|
||||
Global Const acCurrent = -1
|
||||
|
||||
REM AcDataObjectType
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const acActiveDataObject = -1
|
||||
Global Const acDataForm = 2
|
||||
Global Const acDataQuery = 1
|
||||
Global Const acDataServerView = 7
|
||||
Global Const acDataStoredProcedure = 9
|
||||
Global Const acDataTable = 0
|
||||
|
||||
REM AcQuitOption
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const acQuitPrompt = 0
|
||||
Global Const acQuitSaveAll = 1
|
||||
Global Const acQuitSaveNone = 2
|
||||
|
||||
REM AcCommand
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const acCmdAboutMicrosoftAccess = 35
|
||||
Global Const acCmdAboutOpenOffice = 35
|
||||
Global Const acCmdAboutLibreOffice = 35
|
||||
Global Const acCmdVisualBasicEditor = 525
|
||||
Global Const acCmdBringToFront = 52
|
||||
Global Const acCmdClose = 58
|
||||
Global Const acCmdToolbarsCustomize = 165
|
||||
Global Const acCmdChangeToCommandButton = 501
|
||||
Global Const acCmdChangeToCheckBox = 231
|
||||
Global Const acCmdChangeToComboBox = 230
|
||||
Global Const acCmdChangeToTextBox = 227
|
||||
Global Const acCmdChangeToLabel = 228
|
||||
Global Const acCmdChangeToImage = 234
|
||||
Global Const acCmdChangeToListBox = 229
|
||||
Global Const acCmdChangeToOptionButton = 233
|
||||
Global Const acCmdCopy = 190
|
||||
Global Const acCmdCut = 189
|
||||
Global Const acCmdCreateRelationship = 150
|
||||
Global Const acCmdDelete = 337
|
||||
Global Const acCmdDatabaseProperties = 256
|
||||
Global Const acCmdSQLView = 184
|
||||
Global Const acCmdRemove = 366
|
||||
Global Const acCmdDesignView = 183
|
||||
Global Const acCmdFormView = 281
|
||||
Global Const acCmdNewObjectForm = 136
|
||||
Global Const acCmdNewObjectTable = 134
|
||||
Global Const acCmdNewObjectView = 350
|
||||
Global Const acCmdOpenDatabase = 25
|
||||
Global Const acCmdNewObjectQuery = 135
|
||||
Global Const acCmdShowAllRelationships = 149
|
||||
Global Const acCmdNewObjectReport = 137
|
||||
Global Const acCmdSelectAll = 333
|
||||
Global Const acCmdRemoveTable = 84
|
||||
Global Const acCmdOpenTable = 221
|
||||
Global Const acCmdRename = 143
|
||||
Global Const acCmdDeleteRecord = 223
|
||||
Global Const acCmdApplyFilterSort = 93
|
||||
Global Const acCmdSnapToGrid = 62
|
||||
Global Const acCmdViewGrid = 63
|
||||
Global Const acCmdInsertHyperlink = 259
|
||||
Global Const acCmdMaximumRecords = 508
|
||||
Global Const acCmdObjectBrowser = 200
|
||||
Global Const acCmdPaste = 191
|
||||
Global Const acCmdPasteSpecial = 64
|
||||
Global Const acCmdPrint = 340
|
||||
Global Const acCmdPrintPreview = 54
|
||||
Global Const acCmdSaveRecord = 97
|
||||
Global Const acCmdFind = 30
|
||||
Global Const acCmdUndo = 292
|
||||
Global Const acCmdRefresh = 18
|
||||
Global Const acCmdRemoveFilterSort = 144
|
||||
Global Const acCmdRunMacro = 31
|
||||
Global Const acCmdSave = 20
|
||||
Global Const acCmdSaveAs = 21
|
||||
Global Const acCmdSelectAllRecords = 109
|
||||
Global Const acCmdSendToBack = 53
|
||||
Global Const acCmdSortDescending = 164
|
||||
Global Const acCmdSortAscending = 163
|
||||
Global Const acCmdTabOrder = 41
|
||||
Global Const acCmdDatasheetView = 282
|
||||
Global Const acCmdZoomSelection = 371
|
||||
|
||||
REM AcSendObjectType
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const acSendForm = 2
|
||||
Global Const acSendNoObject = -1
|
||||
Global Const acSendQuery = 1
|
||||
Global Const acSendReport = 3
|
||||
Global Const acSendTable = 0
|
||||
|
||||
REM AcOutputObjectType
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const acOutputTable = 0
|
||||
Global Const acOutputQuery = 1
|
||||
Global Const acOutputForm = 2
|
||||
Global Const acOutputArray = -1
|
||||
|
||||
REM AcEncoding
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const acUTF8Encoding = 76
|
||||
|
||||
REM AcFormat
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const acFormatPDF = "writer_pdf_Export"
|
||||
Global Const acFormatODT = "writer8"
|
||||
Global Const acFormatDOC = "MS Word 97"
|
||||
Global Const acFormatHTML = "HTML"
|
||||
Global Const acFormatODS = "calc8"
|
||||
Global Const acFormatXLS = "MS Excel 97"
|
||||
Global Const acFormatXLSX = "Calc MS Excel 2007 XML"
|
||||
Global Const acFormatTXT = "Text - txt - csv (StarCalc)"
|
||||
|
||||
REM AcExportQuality
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const acExportQualityPrint = 0
|
||||
Global Const acExportQualityScreen = 1
|
||||
|
||||
REM AcSysCmdAction
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const acSysCmdAccessDir = 9
|
||||
Global Const acSysCmdAccessVer = 7
|
||||
Global Const acSysCmdClearHelpTopic = 11
|
||||
Global Const acSysCmdClearStatus = 5
|
||||
Global Const acSysCmdGetObjectState = 10
|
||||
Global Const acSysCmdGetWorkgroupFile = 13
|
||||
Global Const acSysCmdIniFile = 8
|
||||
Global Const acSysCmdInitMeter = 1
|
||||
Global Const acSysCmdProfile = 12
|
||||
Global Const acSysCmdRemoveMeter = 3
|
||||
Global Const acSysCmdRuntime = 6
|
||||
Global Const acSysCmdSetStatus = 4
|
||||
Global Const acSysCmdUpdateMeter = 2
|
||||
|
||||
REM Type property
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const dbBigInt = 16
|
||||
Global Const dbBinary = 9
|
||||
Global Const dbBoolean = 1
|
||||
Global Const dbByte = 2
|
||||
Global Const dbChar = 18
|
||||
Global Const dbCurrency = 5
|
||||
Global Const dbDate = 8
|
||||
Global Const dbDecimal = 20
|
||||
Global Const dbDouble = 7
|
||||
Global Const dbFloat = 21
|
||||
Global Const dbGUID = 15
|
||||
Global Const dbInteger = 3
|
||||
Global Const dbLong = 4
|
||||
Global Const dbLongBinary = 11 ' (OLE Object)
|
||||
Global Const dbMemo= 12
|
||||
Global Const dbNumeric = 19
|
||||
Global Const dbSingle = 6
|
||||
Global Const dbText = 10
|
||||
Global Const dbTime = 22
|
||||
Global Const dbTimeStamp = 23
|
||||
Global Const dbVarBinary = 17
|
||||
Global Const dbUndefined = -1
|
||||
|
||||
REM Attributes property
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const dbAutoIncrField = 16
|
||||
Global Const dbDescending = 1
|
||||
Global Const dbFixedField = 1
|
||||
Global Const dbHyperlinkField = 32768
|
||||
Global Const dbSystemField = 8192
|
||||
Global Const dbUpdatableField = 32
|
||||
Global Const dbVariableField = 2
|
||||
|
||||
REM OpenRecordset
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const dbOpenForwardOnly = 8
|
||||
Global Const dbSQLPassThrough = 64
|
||||
Global Const dbReadOnly = 4
|
||||
|
||||
REM Query types
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const dbQAction = 240
|
||||
Global Const dbQAppend = 64
|
||||
Global Const dbQDDL = 4 '96
|
||||
Global Const dbQDelete = 32
|
||||
Global Const dbQMakeTable = 128 '80
|
||||
Global Const dbQSelect = 0
|
||||
Global Const dbQSetOperation = 8 '128
|
||||
Global Const dbQSQLPassThrough = 1 '112
|
||||
Global Const dbQUpdate = 16 '48
|
||||
|
||||
REM Edit mode
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const dbEditNone = 0
|
||||
Global Const dbEditInProgress = 1
|
||||
Global Const dbEditAdd = 2
|
||||
|
||||
REM Toolbars
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const msoBarTypeNormal = 0 ' Usual toolbar
|
||||
Global Const msoBarTypeMenuBar = 1 ' Menu bar
|
||||
Global Const msoBarTypePopup = 2 ' Shortcut menu
|
||||
Global Const msoBarTypeStatusBar = 11 ' Status bar
|
||||
Global Const msoBarTypeFloater = 12 ' Floating window
|
||||
|
||||
Global Const msoControlButton = 1 ' Command button
|
||||
Global Const msoControlPopup = 10 ' Popup, submenu
|
||||
|
||||
REM New Lines
|
||||
REM -----------------------------------------------------------------
|
||||
Public Function vbCr() As String : vbCr = Chr(13) : End Function
|
||||
Public Function vbLf() As String : vbLf = Chr(10) : End Function
|
||||
Public Function vbNewLine() As String
|
||||
Const cstWindows = 1
|
||||
If GetGuiType() = cstWindows Then vbNewLine = vbCR & vbLF Else vbNewLine = vbLF
|
||||
End Function ' vbNewLine V1.4.0
|
||||
Public Function vbTab() As String : vbTab = Chr(9) : End Function
|
||||
|
||||
REM Module types
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const acClassModule = 1
|
||||
Global Const acStandardModule = 0
|
||||
|
||||
REM (Module) procedure types
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const vbext_pk_Get = 1 ' A Property Get procedure
|
||||
Global Const vbext_pk_Let = 2 ' A Property Let procedure
|
||||
Global Const vbext_pk_Proc = 0 ' A Sub or Function procedure
|
||||
Global Const vbext_pk_Set = 3 ' A Property Set procedure
|
||||
|
||||
</script:module>
|
||||
@@ -0,0 +1,6 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE library:library PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "library.dtd">
|
||||
<library:library xmlns:library="http://openoffice.org/2000/library" library:name="Access2Base" library:readonly="false" library:passwordprotected="false">
|
||||
<library:element library:name="dlgTrace"/>
|
||||
<library:element library:name="dlgFormat"/>
|
||||
</library:library>
|
||||
@@ -0,0 +1,19 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE dlg:window PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "dialog.dtd">
|
||||
<dlg:window xmlns:dlg="http://openoffice.org/2000/dialog" xmlns:script="http://openoffice.org/2000/script" dlg:id="dlgFormat" dlg:left="246" dlg:top="119" dlg:width="153" dlg:height="40" dlg:help-text="Export the form" dlg:closeable="true" dlg:moveable="true" dlg:title="OutputTo">
|
||||
<dlg:bulletinboard>
|
||||
<dlg:combobox dlg:id="cboFormat" dlg:tab-index="0" dlg:left="4" dlg:top="18" dlg:width="71" dlg:height="8" dlg:help-text="Format in which the form should be exported" dlg:value="PDF" dlg:spin="true">
|
||||
<dlg:menupopup>
|
||||
<dlg:menuitem dlg:value="PDF"/>
|
||||
<dlg:menuitem dlg:value="ODT"/>
|
||||
<dlg:menuitem dlg:value="DOC"/>
|
||||
<dlg:menuitem dlg:value="HTML"/>
|
||||
</dlg:menupopup>
|
||||
</dlg:combobox>
|
||||
<dlg:text dlg:id="lblFormat" dlg:tab-index="1" dlg:left="4" dlg:top="7" dlg:width="100" dlg:height="9" dlg:help-text="Format in which the form should be exported" dlg:value="Select the output format"/>
|
||||
<dlg:button dlg:id="cmdOK" dlg:tab-index="2" dlg:left="111" dlg:top="5" dlg:width="35" dlg:height="12" dlg:help-text="Validate your choice" dlg:default="true" dlg:value="OK" dlg:button-type="ok">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Access2Base.Trace._TraceOK?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:button dlg:id="cmdCancel" dlg:tab-index="3" dlg:left="111" dlg:top="20" dlg:width="35" dlg:height="12" dlg:help-text="Cancel and close the dialog" dlg:value="Cancel" dlg:button-type="cancel"/>
|
||||
</dlg:bulletinboard>
|
||||
</dlg:window>
|
||||
@@ -0,0 +1,33 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE dlg:window PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "dialog.dtd">
|
||||
<dlg:window xmlns:dlg="http://openoffice.org/2000/dialog" xmlns:script="http://openoffice.org/2000/script" dlg:id="dlgTrace" dlg:left="81" dlg:top="63" dlg:width="438" dlg:height="154" dlg:help-text="Manage the console file and its entries" dlg:closeable="true" dlg:moveable="true" dlg:title="Console">
|
||||
<dlg:styles>
|
||||
<dlg:style dlg:style-id="0" dlg:font-name="Courier New" dlg:font-stylename="Regular" dlg:font-family="modern"/>
|
||||
<dlg:style dlg:style-id="1" dlg:look="simple"/>
|
||||
<dlg:style dlg:style-id="2" dlg:background-color="0xe6e6e6" dlg:border="none"/>
|
||||
</dlg:styles>
|
||||
<dlg:bulletinboard>
|
||||
<dlg:text dlg:id="lblEntries" dlg:tab-index="3" dlg:left="265" dlg:top="134" dlg:width="130" dlg:height="9" dlg:help-text="Clear the list and resize the circular buffer" dlg:value="Set max number of entries" dlg:align="right"/>
|
||||
<dlg:numericfield dlg:id="numEntries" dlg:tab-index="4" dlg:left="399" dlg:top="129" dlg:width="28" dlg:height="16" dlg:help-text="Clear the list and resize the circular buffer" dlg:decimal-accuracy="0" dlg:value="20" dlg:value-min="5" dlg:value-max="999" dlg:spin="true"/>
|
||||
<dlg:textfield dlg:style-id="0" dlg:id="txtTraceLog" dlg:tab-index="0" dlg:left="9" dlg:top="20" dlg:width="360" dlg:height="105" dlg:help-text="Text can be selected, copied, ..." dlg:hscroll="true" dlg:vscroll="true" dlg:multiline="true" dlg:readonly="true" dlg:value="--- Log file is empty ---"/>
|
||||
<dlg:checkbox dlg:style-id="1" dlg:id="chkClear" dlg:tab-index="5" dlg:left="58" dlg:top="133" dlg:width="6" dlg:height="9" dlg:help-text="Clear the list" dlg:value="Clear" dlg:checked="false"/>
|
||||
<dlg:button dlg:id="cmdCancel" dlg:tab-index="6" dlg:left="381" dlg:top="38" dlg:width="40" dlg:height="12" dlg:help-text="Cancel and close the dialog" dlg:value="Cancel" dlg:button-type="cancel"/>
|
||||
<dlg:text dlg:id="lblClear" dlg:tab-index="7" dlg:left="9" dlg:top="133" dlg:width="46" dlg:height="9" dlg:help-text="Clear the list" dlg:value="Clear the list" dlg:align="right"/>
|
||||
<dlg:text dlg:id="lblMinLevel" dlg:tab-index="8" dlg:left="74" dlg:top="133" dlg:width="130" dlg:height="9" dlg:help-text="Register only logging requests above given level" dlg:value="Set minimal trace level" dlg:align="right"/>
|
||||
<dlg:combobox dlg:id="cboMinLevel" dlg:tab-index="9" dlg:left="209" dlg:top="133" dlg:width="50" dlg:height="9" dlg:help-text="Register only logging requests above given level" dlg:spin="true">
|
||||
<dlg:menupopup>
|
||||
<dlg:menuitem dlg:value="DEBUG"/>
|
||||
<dlg:menuitem dlg:value="INFO"/>
|
||||
<dlg:menuitem dlg:value="WARNING"/>
|
||||
<dlg:menuitem dlg:value="ERROR"/>
|
||||
<dlg:menuitem dlg:value="ABORT"/>
|
||||
</dlg:menupopup>
|
||||
</dlg:combobox>
|
||||
<dlg:button dlg:id="cmdOK" dlg:tab-index="1" dlg:left="381" dlg:top="20" dlg:width="40" dlg:height="12" dlg:help-text="Validate" dlg:default="true" dlg:value="OK" dlg:button-type="ok"/>
|
||||
<dlg:button dlg:id="cmdDump" dlg:tab-index="2" dlg:left="381" dlg:top="68" dlg:width="40" dlg:height="31" dlg:help-text="Choose a file and dump the actual list content in it" dlg:value="Dump to file" dlg:multiline="true">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Access2Base.Trace._DumpToFile?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:text dlg:id="lblNbEntries" dlg:tab-index="10" dlg:left="9" dlg:top="10" dlg:width="105" dlg:height="7" dlg:help-text="Actual size of list" dlg:value="Actual number of entries:"/>
|
||||
<dlg:numericfield dlg:style-id="2" dlg:id="numNbEntries" dlg:tab-index="11" dlg:left="123" dlg:top="9" dlg:width="17" dlg:height="9" dlg:help-text="Actual size of list" dlg:readonly="true" dlg:decimal-accuracy="0" dlg:value="0"/>
|
||||
</dlg:bulletinboard>
|
||||
</dlg:window>
|
||||
@@ -0,0 +1,34 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE library:library PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "library.dtd">
|
||||
<library:library xmlns:library="http://openoffice.org/2000/library" library:name="Access2Base" library:readonly="false" library:passwordprotected="false">
|
||||
<library:element library:name="Application"/>
|
||||
<library:element library:name="Methods"/>
|
||||
<library:element library:name="acConstants"/>
|
||||
<library:element library:name="Test"/>
|
||||
<library:element library:name="Trace"/>
|
||||
<library:element library:name="DoCmd"/>
|
||||
<library:element library:name="Utils"/>
|
||||
<library:element library:name="Database"/>
|
||||
<library:element library:name="PropertiesSet"/>
|
||||
<library:element library:name="Collect"/>
|
||||
<library:element library:name="PropertiesGet"/>
|
||||
<library:element library:name="Form"/>
|
||||
<library:element library:name="Python"/>
|
||||
<library:element library:name="_License"/>
|
||||
<library:element library:name="SubForm"/>
|
||||
<library:element library:name="L10N"/>
|
||||
<library:element library:name="OptionGroup"/>
|
||||
<library:element library:name="Event"/>
|
||||
<library:element library:name="Property"/>
|
||||
<library:element library:name="Control"/>
|
||||
<library:element library:name="Dialog"/>
|
||||
<library:element library:name="Field"/>
|
||||
<library:element library:name="DataDef"/>
|
||||
<library:element library:name="Recordset"/>
|
||||
<library:element library:name="TempVar"/>
|
||||
<library:element library:name="Root_"/>
|
||||
<library:element library:name="UtilProperty"/>
|
||||
<library:element library:name="CommandBar"/>
|
||||
<library:element library:name="CommandBarControl"/>
|
||||
<library:element library:name="Module"/>
|
||||
</library:library>
|
||||
Reference in New Issue
Block a user