[Libreoffice-commits] core.git: wizards/Package_access2base.mk wizards/source
Jean-Pierre Ledure
jp at ledure.be
Tue Dec 30 05:11:36 PST 2014
wizards/Package_access2base.mk | 2
wizards/source/access2base/Application.xba | 193 ++++++++++++++++++++-
wizards/source/access2base/Collect.xba | 2
wizards/source/access2base/CommandBar.xba | 252 ++++++++++++++++++++++++++++
wizards/source/access2base/Dialog.xba | 2
wizards/source/access2base/DoCmd.xba | 9 -
wizards/source/access2base/L10N.xba | 4
wizards/source/access2base/Test.xba | 26 --
wizards/source/access2base/UtilProperty.xba | 183 ++++++++++++++++++++
wizards/source/access2base/acConstants.xba | 10 +
wizards/source/access2base/script.xlb | 2
11 files changed, 639 insertions(+), 46 deletions(-)
New commits:
commit 468474953847859e7ff707b5cbe87a443c00aed6
Author: Jean-Pierre Ledure <jp at ledure.be>
Date: Tue Dec 30 13:04:11 2014 +0100
Access2Base - CommandBars collection - show/hide toolbars
Addition of CommandBars collection
Addition of CommandBar class
diff --git a/wizards/Package_access2base.mk b/wizards/Package_access2base.mk
index 3094b21..522ca03 100644
--- a/wizards/Package_access2base.mk
+++ b/wizards/Package_access2base.mk
@@ -24,6 +24,7 @@ $(eval $(call gb_Package_add_files,wizards_basicsrvaccess2base,$(LIBO_SHARE_FOLD
acConstants.xba \
Application.xba \
Collect.xba \
+ CommandBar.xba \
Compatible.xba \
Control.xba \
Database.xba \
@@ -49,6 +50,7 @@ $(eval $(call gb_Package_add_files,wizards_basicsrvaccess2base,$(LIBO_SHARE_FOLD
TempVar.xba \
Test.xba \
Trace.xba \
+ UtilProperty.xba \
Utils.xba \
))
diff --git a/wizards/source/access2base/Application.xba b/wizards/source/access2base/Application.xba
index 162575c..304d6db 100644
--- a/wizards/source/access2base/Application.xba
+++ b/wizards/source/access2base/Application.xba
@@ -71,6 +71,7 @@ Global Const ERRTABLEDEFDELETED = 1550
Global Const ERRTABLECREATION = 1551
Global Const ERRFIELDCREATION = 1552
Global Const ERRSUBFORMNOTFOUND = 1553
+Global Const ERRWINDOW = 1554
REM -----------------------------------------------------------------------------------------------------------------------
Global Const DBCONNECTBASE = 1 ' Connection from Base document (OpenConnection)
@@ -78,20 +79,22 @@ Global Const DBCONNECTFORM = 2 ' Connection from a database-aware form
Global Const DBCONNECTANY = 3 ' Connection from any document for data access only (OpenDatabase)
REM -----------------------------------------------------------------------------------------------------------------------
-Global Const COLLALLDIALOGS = "ALLDIALOGS"
-Global Const COLLALLFORMS = "ALLFORMS"
-Global Const COLLCONTROLS = "CONTROLS"
-Global Const COLLFORMS = "FORMS"
-Global Const COLLFIELDS = "FIELDS"
-Global Const COLLPROPERTIES = "PROPERTIES"
-Global Const COLLQUERYDEFS = "QUERYDEFS"
-Global Const COLLRECORDSETS = "RECORDSETS"
-Global Const COLLTABLEDEFS = "TABLEDEFS"
-Global Const COLLTEMPVARS = "TEMPVARS"
+Global Const COLLALLDIALOGS = "ALLDIALOGS"
+Global Const COLLALLFORMS = "ALLFORMS"
+Global Const COLLCOMMANDBARS = "COMMANDBARS"
+Global Const COLLCONTROLS = "CONTROLS"
+Global Const COLLFORMS = "FORMS"
+Global Const COLLFIELDS = "FIELDS"
+Global Const COLLPROPERTIES = "PROPERTIES"
+Global Const COLLQUERYDEFS = "QUERYDEFS"
+Global Const COLLRECORDSETS = "RECORDSETS"
+Global Const COLLTABLEDEFS = "TABLEDEFS"
+Global Const COLLTEMPVARS = "TEMPVARS"
REM -----------------------------------------------------------------------------------------------------------------------
Global Const OBJAPPLICATION = "APPLICATION"
Global Const OBJCOLLECTION = "COLLECTION"
+Global Const OBJCOMMANDBAR = "COMMANDBAR"
Global Const OBJCONTROL = "CONTROL"
Global Const OBJDATABASE = "DATABASE"
Global Const OBJDIALOG = "DIALOG"
@@ -412,6 +415,147 @@ Exit_Sub:
End Sub ' CloseConnection V1.2.0
REM -----------------------------------------------------------------------------------------------------------------------
+Public Function CommandBars(Optional ByVal pvIndex As Variant) As Variant
+' Return an object of type CommandBar indicated by its index or its name (CASE-INSENSITIVE string)
+' If no pvIndex argument, return a Collection type
+
+ If _ErrorHandler() Then On Local Error Goto Error_Function
+Const cstThisSub = "CommandBars"
+ Utils._SetCalledSub(cstThisSub)
+
+Dim iObjectsCount As Integer, sObjectName As String, oObject As Object
+Dim oWindow As Object, iWindowType As Integer
+Dim i As Integer, j As Integer, k As Integer, bFound As Boolean
+Dim sSupportedModules() As Variant, vModules() As Variant, oModuleUI As Object
+Dim oToolbar As Object, sToolbarName As String, vUIElements() As Variant, sToolbarFullName As String, iBuiltin As Integer
+
+Const cstCustom = "CUSTOM"
+
+ Set oObject = Nothing
+ If Not IsMissing(pvIndex) Then
+ If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function
+ End If
+
+ iObjectsCount = 0
+ bFound = False
+ iBuiltin = 1 ' Default = builtin
+
+ Set oWindow = _SelectWindow
+ If IsNull(oWindow.Frame) Then Goto Trace_WindowError
+
+ ' List of 21 modules
+ vModules = CreateUnoService("com.sun.star.frame.ModuleManager").getElementNames()
+
+ iWindowType = oWindow.WindowType
+ Select Case iWindowType ' Supported window types only
+ Case acForm
+ sSupportedModules = Array( "com.sun.star.sdb.FormDesign" )
+ Case acBasicIDE _
+ , acDatabaseWindow _
+ , acReport _
+ , acDocument _
+ , acTable _
+ , acQuery _
+ , acDiagram
+ sSupportedModules = Array()
+ Case Else
+ End Select
+
+ ' Find all standard and custom toolbars stored in LibO/AOO Base
+ Set oModuleUI = CreateUnoService("com.sun.star.ui.ModuleUIConfigurationManagerSupplier")
+ For k = 0 To UBound(vModules)
+ For j = 0 To UBound(sSupportedModules)
+ If vModules(k) = sSupportedModules(j) Then ' Supported modules only
+ Set oToolbar = oModuleUI.getUIConfigurationManager(vModules(k))
+ vUIElements() = oToolbar.getUIElementsInfo(0)
+ For i = 0 To UBound(vUIElements)
+ sToolbarFullName = _GetPropertyValue(vUIElements(i), "ResourceURL")
+ sToolbarName = Split(sToolbarFullName, "/")(2)
+ If Len(sToolbarName) > Len(cstCustom) Then
+ If Left(UCase(sToolbarName), Len(cstCustom)) = cstCustom Then
+ sToolbarName = _GetPropertyValue(vUIElements(i), "UIName")
+ iBuiltin = 2
+ End If
+ End If
+
+ iObjectsCount = iObjectsCount + 1
+ Select Case True
+ Case IsMissing(pvIndex)
+ Case VarType(pvIndex) = vbString
+ If UCase(pvIndex) = UCase(sToolbarName) Then bFound = True
+ Case Else
+ If pvIndex < 0 Then Goto Trace_IndexError
+ If pvIndex = iObjectsCount - 1 Then bFound = True
+ End Select
+
+ If bFound Then
+ Set oObject = _NewCommandBar(vModules(k), sToolbarName, sToolbarFullName, iBuiltin)
+ Set oObject._Window = oWindow.Frame
+ Set oObject._Toolbar = oToolbar
+ Goto Exit_Function
+ End If
+ Next i
+ End If
+ Next j
+ Next k
+
+ ' Find all (not builtin) toolbars stored in current document (typically forms)
+ iBuiltin = 3 ' Stored in form itself
+ Set oToolbar = oWindow.Frame.Controller.Model.getUIConfigurationManager
+ vUIElements() = oToolbar.getUIElementsInfo(0)
+ For i = 0 To UBound(vUIElements)
+ sToolbarFullName = _GetPropertyValue(vUIElements(i), "ResourceURL")
+ sToolbarName = _GetPropertyValue(vUIElements(i), "UIName")
+ iObjectsCount = iObjectsCount + 1
+ Select Case True
+ Case IsMissing(pvIndex)
+ Case VarType(pvIndex) = vbString
+ If UCase(pvIndex) = UCase(sToolbarName) Then bFound = True
+ Case Else
+ If pvIndex = iObjectsCount - 1 Then bFound = True
+ End Select
+ If bFound Then
+ Set oObject = _NewCommandBar("", sToolbarName, sToolbarFullName, iBuiltin)
+ Set oObject._Window = oWindow.Frame
+ Set oObject._Toolbar = oToolbar
+ Goto Exit_Function
+ End If
+ Next i
+
+ ' MISSING : CUSTOM POPUPS <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+
+ Select Case True
+ Case IsMissing(pvIndex)
+ Set oObject = New Collect
+ oObject._CollType = COLLCOMMANDBARS
+ oObject._ParentType = OBJAPPLICATION
+ oObject._Count = iObjectsCount
+ Case VarType(pvIndex) = vbString
+ Goto Trace_NotFound
+ Case Else ' pvIndex is numeric
+ Goto Trace_IndexError
+ End Select
+
+Exit_Function:
+ Set CommandBars = oObject
+ Set oObject = Nothing
+ Utils._ResetCalledSub(cstThisSub)
+ Exit Function
+Error_Function:
+ TraceError(TRACEABORT, Err, cstThisSub, Erl)
+ GoTo Exit_Function
+Trace_NotFound:
+ TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel("COMMANDBAR"), pvIndex))
+ Goto Exit_Function
+Trace_IndexError:
+ TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0)
+ Goto Exit_Function
+Trace_WindowError:
+ TraceError(TRACEFATAL, ERRWINDOW, Utils._CalledSub(), 0)
+ Goto Exit_Function
+End Function ' CommandBars V1,3,0
+
+REM -----------------------------------------------------------------------------------------------------------------------
Public Function Controls(ByVal Optional pvObject As Variant, Optional ByVal pvIndex As Variant) As Variant
' Return an object of type Control indicated by either its index (integer) or its name (CASE-INSENSITIVE string)
' The 1st argument pvObject can be either
@@ -1235,6 +1379,35 @@ Dim vBar As Variant, vWindow As Variant, vController As Object
End Function ' _NewBar V1.1.0
REM -----------------------------------------------------------------------------------------------------------------------
+Private Function _NewCommandBar(psModule As String _
+ , psToolbarName As String _
+ , psToolbarFullName As String _
+ , piBuiltin As Integer _
+ ) As Object
+
+Dim oObject As Object
+ Set oObject = New CommandBar
+ With oObject
+ ._Type = OBJCOMMANDBAR
+ ._Name = psToolbarName
+ ._ResourceURL = psToolbarFullName
+ ._Module = psModule
+ ._BarBuiltin = piBuiltin
+ Select Case UCase(Split(psToolbarFullName, "/")(1))
+ Case "MENUBAR" : ._BarType = msoBarTypeMenuBar
+ Case "STATUSBAR" : ._BarType = msoBarTypeStatusBar
+ Case "TOOLBAR" : ._BarType = msoBarTypeNormal
+ Case "POPUP" : ._BarType = msoBarTypePopup
+ Case "FLOATER" : ._BarType = msoBarTypeFloater
+ Case Else : ._BarType = -1
+ End Select
+ End With
+ Set _NewCommandBar = oObject
+ Exit Function
+
+End Function ' NewCommandBar V1.3.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
Public Sub _RootInit(Optional ByVal pbForce As Boolean)
' Initialize _A2B_ global variable. Reinit forced if pbForce = True
diff --git a/wizards/source/access2base/Collect.xba b/wizards/source/access2base/Collect.xba
index b8a7223..9039584 100644
--- a/wizards/source/access2base/Collect.xba
+++ b/wizards/source/access2base/Collect.xba
@@ -72,6 +72,8 @@ Dim vNames() As Variant, oProperty As Object
Set Item = Application.AllDialogs(pvItem)
Case COLLALLFORMS
Set Item = Application.AllForms(pvItem)
+ Case COLLCOMMANDBARS
+ Set Item = Application.CommandBars(pvItem)
Case COLLCONTROLS
Select Case _ParentType
Case OBJCONTROL, OBJSUBFORM
diff --git a/wizards/source/access2base/CommandBar.xba b/wizards/source/access2base/CommandBar.xba
new file mode 100644
index 0000000..c8510a9
--- /dev/null
+++ b/wizards/source/access2base/CommandBar.xba
@@ -0,0 +1,252 @@
+<?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 _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
+ _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 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, _Name, vPropertiesList)
+ Else
+ vProperty = PropertiesGet._Properties(sObject, _Name, 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 (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("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 -----------------------------------------------------------------------------------------------------------------------
+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>
\ No newline at end of file
diff --git a/wizards/source/access2base/Dialog.xba b/wizards/source/access2base/Dialog.xba
index a6d04d2..01f1973 100644
--- a/wizards/source/access2base/Dialog.xba
+++ b/wizards/source/access2base/Dialog.xba
@@ -659,4 +659,4 @@ Error_Function:
_PropertySet = False
GoTo Exit_Function
End Function ' _PropertySet
-</script:module>
+</script:module>
\ No newline at end of file
diff --git a/wizards/source/access2base/DoCmd.xba b/wizards/source/access2base/DoCmd.xba
index 4a31284..0ca7dd6 100644
--- a/wizards/source/access2base/DoCmd.xba
+++ b/wizards/source/access2base/DoCmd.xba
@@ -2018,15 +2018,6 @@ Public Function _getUpperShortcut(ByVal psShortcut As String, ByVal psLastCompon
End Function ' _getUpperShortcut
REM -----------------------------------------------------------------------------------------------------------------------
-Public Function _MakePropertyValue(ByVal Optional psName As String, ByVal Optional pvValue As Variant) As com.sun.star.beans.PropertyValue
-'Build PropertyValue(s) array
-
-Dim oPropertyValue As New com.sun.star.beans.PropertyValue
- If Not IsMissing(psName) Then oPropertyValue.Name = psName
- If Not IsMissing(pvValue) Then oPropertyValue.Value = pvValue
- _MakePropertyValue() = oPropertyValue
-End Function ' _MakePropertyValue
-
REM -----------------------------------------------------------------------------------------------------------------------
Private Function _OpenObject(ByVal psObjectType As String _
, ByVal pvObjectName As Variant _
diff --git a/wizards/source/access2base/L10N.xba b/wizards/source/access2base/L10N.xba
index fce1cee..691be2a 100644
--- a/wizards/source/access2base/L10N.xba
+++ b/wizards/source/access2base/L10N.xba
@@ -77,6 +77,7 @@ Dim sLocal As String
Case "ERR" & ERRTABLECREATION : sLocal = "Table '%0' could not be created"
Case "ERR" & ERRFIELDCREATION : sLocal = "Field '%0' could not be created"
Case "ERR" & ERRSUBFORMNOTFOUND : sLocal = "Subform '%0' not found in parent form '%1'"
+ Case "ERR" & ERRWINDOW : sLocal = "Current window is not a document"
'----------------------------------------------------------------------------------------------------------------------
Case "OBJECT" : sLocal = "Object"
Case "TABLE" : sLocal = "Table"
@@ -86,6 +87,7 @@ Dim sLocal As String
Case "RECORDSET" : sLocal = "Recordset"
Case "FIELD" : sLocal = "Field"
Case "TEMPVAR" : sLocal = "Temporary variable"
+ Case "COMAMANDBAR" : sLocal = "Command bar"
'----------------------------------------------------------------------------------------------------------------------
Case "ERR#" : sLocal = "Error #"
Case "ERROCCUR" : sLocal = "occurred"
@@ -183,6 +185,7 @@ Dim sLocal As String
Case "ERR" & ERRTABLECREATION : sLocal = "La table '%0' n'a pas pu être créée"
Case "ERR" & ERRFIELDCREATION : sLocal = "Le champ '%0' n'a pas pu être créé"
Case "ERR" & ERRSUBFORMNOTFOUND : sLocal = "Sous-formulaire '%0' non trouvé dans le formulaire parent '%1'"
+ Case "ERR" & ERRWINDOW : sLocal = "La fenêtre courante n'est pas un document"
'----------------------------------------------------------------------------------------------------------------------
Case "OBJECT" : sLocal = "Objet"
Case "TABLE" : sLocal = "Table"
@@ -191,6 +194,7 @@ Dim sLocal As String
Case "REPORT" : sLocal = "Rapport"
Case "RECORDSET" : sLocal = "Recordset"
Case "FIELD" : sLocal = "Champ"
+ Case "COMAMANDBAR" : sLocal = "Barre de commande"
Case "TEMPVAR" : sLocal = "Variable temporaire"
'----------------------------------------------------------------------------------------------------------------------
Case "ERR#" : sLocal = "L'erreur #"
diff --git a/wizards/source/access2base/Test.xba b/wizards/source/access2base/Test.xba
index 4f64ba2..b69d93f 100644
--- a/wizards/source/access2base/Test.xba
+++ b/wizards/source/access2base/Test.xba
@@ -4,30 +4,6 @@
'Option Compatible
Sub Main
- 'Application._RootInit()
- _A2B_.CalledSub = ""
- Application.SysCmd(acSysCmdRemoveMeter)
-Dim a as variant, b as variant, c as variant, d as variant, i as integer, s as string,f as variant, h as variant, j as long, k as integer, l as integer, sFile As String
-Dim lTime1 as Long, lTime2 as Long
- lTime1=getsystemticks()
-' TraceConsole()
- _ErrorHandler(False)
- traceconsole()
- exit sub
- CurrentDb().CloseAllrecordsets()
- Set a = CurrentDb().TableDefs("Alltypes")
- Set b = a.OpenRecordset( , , dbreadOnly)
-Dim vVar() As Variant
- Set vVar = b.GetRows(1000)
- b.mClose()
- DebugPrint UBound(vVar, 1), UBound(vVar, 2)
- For i = 0 To UBound(vVar, 2)
- For j = 0 To UBound(vVar, 1)
- DebugPrint i, j, vVar(j, i)
- Next j
- Next i
- lTime2=getsystemticks
- debugprint lTime2 - lTime1
- exit sub
End Sub
+
</script:module>
\ No newline at end of file
diff --git a/wizards/source/access2base/UtilProperty.xba b/wizards/source/access2base/UtilProperty.xba
new file mode 100644
index 0000000..b1530c1
--- /dev/null
+++ b/wizards/source/access2base/UtilProperty.xba
@@ -0,0 +1,183 @@
+<?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 at 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
+'**********************************************************************
+
+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 Object
+ Set oPropertyValue = createUnoStruct( "com.sun.star.beans.PropertyValue" )
+ If Not IsMissing(psName) Then oPropertyValue.Name = psName
+ If Not IsMissing(pvValue) Then oPropertyValue.Value = pvValue
+ _MakePropertyValue() = oPropertyValue
+
+End Function ' _MakePropertyValue V1.3.0
+
+REM =======================================================================================================================
+Public Function _NumPropertyValues(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(pvPropertyValuesArray, 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(pvPropertyValuesArray, 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
+ iPropIndex = _FindPropertyIndex(pvPropertyValuesArray, psPropName)
+ If iPropIndex >= 0 Then
+ vProp = pvPropertyValuesArray(iPropIndex) ' access array subscript
+ _FindProperty() = vProp
+ EndIf
+
+End Function ' _FindProperty V1.3.0
+
+REM =======================================================================================================================
+Function _GetPropertyValue(pvPropertyValuesArray, 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
+ iPropIndex = _FindPropertyIndex(pvPropertyValuesArray, psPropName)
+ If iPropIndex >= 0 Then
+ vProp = pvPropertyValuesArray(iPropIndex) ' access array subscript
+ vValue = vProp.Value ' get the value from the PropertyValue
+ _GetPropertyValue() = vValue
+ Else
+ If IsMissing(pvDefaultValue) Then pvDefaultValue = Null
+ _GetPropertyValue() = pvDefaultValue
+ EndIf
+End Function ' _GetPropertyValue V1.3.0
+
+REM =======================================================================================================================
+Sub _SetPropertyValue(pvPropertyValuesArray, ByVal psPropName As String, ByVal pvValue)
+' 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)
+ ' Did we find it?
+ If iPropIndex >= 0 Then
+ ' Found, the PropertyValue is already in the array. Just modify its value.
+ vProp = pvPropertyValuesArray(iPropIndex) ' access array subscript
+ vProp.Value = 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 =======================================================================================================================
+Sub _DeleteProperty(pvPropertyValuesArray, ByVal psPropName As String)
+' Delete a particular named property from an array of PropertyValue's.
+
+Dim iPropIndex As Integer
+ iPropIndex = _FindPropertyIndex(pvPropertyValuesArray, psPropName)
+ _DeleteIndexedProperty(pvPropertyValuesArray, iPropIndex)
+
+End Sub ' _DeletePropertyValue V1.3.0
+
+REM =======================================================================================================================
+Public Sub _DeleteIndexedProperty(pvPropertyValuesArray, 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 feweer element.
+ Redim Preserve pvPropertyValuesArray(iNumProperties - 2)
+ EndIf
+
+End Sub ' _DeleteIndexedProperty V1.3.0
+
+REM =======================================================================================================================
+Public Function _PropValuesToStr(pvPropertyValuesArray) As String
+' Convenience function to return a string which explains what PropertyValue's are in the array of PropertyValue's.
+
+Dim iNumProperties As Integer, sResult As String, i As Integer, vProp As Variant
+Dim sName As String, vValue As Variant
+ iNumProperties = _NumPropertyValues(pvPropertyValuesArray)
+
+ sResult = Cstr(iNumProperties) & " Properties:"
+ For i = 0 To iNumProperties - 1
+ vProp = pvPropertyValuesArray(i)
+ sName = vProp.Name
+ vValue = vProp.Value
+ sResult = sResult & Chr(13) & " " & sName & " = " & _CStr(vValue)
+ Next i
+ _PropValuesToStr() = sResult
+
+End Function ' _PropValuesToStr V1.3.0
+</script:module>
\ No newline at end of file
diff --git a/wizards/source/access2base/acConstants.xba b/wizards/source/access2base/acConstants.xba
index fab9789..f0d1e95 100644
--- a/wizards/source/access2base/acConstants.xba
+++ b/wizards/source/access2base/acConstants.xba
@@ -8,7 +8,7 @@ REM ============================================================================
Option Explicit
REM Access2Base -----------------------------------------------------
-Global Const Access2Base_Version = "1.2.0"
+Global Const Access2Base_Version = "1.3.0"
REM AcCloseSave
REM -----------------------------------------------------------------
@@ -349,4 +349,12 @@ 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
</script:module>
\ No newline at end of file
diff --git a/wizards/source/access2base/script.xlb b/wizards/source/access2base/script.xlb
index 3bdae29..c707c55 100644
--- a/wizards/source/access2base/script.xlb
+++ b/wizards/source/access2base/script.xlb
@@ -27,4 +27,6 @@
<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:library>
\ No newline at end of file
More information about the Libreoffice-commits
mailing list