diff options
author | Jean-Pierre Ledure <jp@ledure.be> | 2014-12-30 13:04:11 +0100 |
---|---|---|
committer | Jean-Pierre Ledure <jp@ledure.be> | 2014-12-30 14:11:03 +0100 |
commit | 468474953847859e7ff707b5cbe87a443c00aed6 (patch) | |
tree | 03e44800cd6cba44d395a676a8d9807ca376d66b /wizards/source | |
parent | 1a3accb148bda7ebe889cbd6177502bd730b0bb8 (diff) |
Access2Base - CommandBars collection - show/hide toolbars
Addition of CommandBars collection
Addition of CommandBar class
Diffstat (limited to 'wizards/source')
-rw-r--r-- | wizards/source/access2base/Application.xba | 193 | ||||
-rw-r--r-- | wizards/source/access2base/Collect.xba | 2 | ||||
-rw-r--r-- | wizards/source/access2base/CommandBar.xba | 252 | ||||
-rw-r--r-- | wizards/source/access2base/Dialog.xba | 2 | ||||
-rw-r--r-- | wizards/source/access2base/DoCmd.xba | 9 | ||||
-rw-r--r-- | wizards/source/access2base/L10N.xba | 4 | ||||
-rw-r--r-- | wizards/source/access2base/Test.xba | 26 | ||||
-rw-r--r-- | wizards/source/access2base/UtilProperty.xba | 183 | ||||
-rw-r--r-- | wizards/source/access2base/acConstants.xba | 10 | ||||
-rw-r--r-- | wizards/source/access2base/script.xlb | 2 |
10 files changed, 637 insertions, 46 deletions
diff --git a/wizards/source/access2base/Application.xba b/wizards/source/access2base/Application.xba index 162575c67ade..304d6db12bba 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 b8a722318cfd..9039584b3300 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 000000000000..c8510a9ff89b --- /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 a6d04d21fb1b..01f19733892f 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 4a3128425856..0ca7dd62f43d 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 fce1ceef9d7e..691be2a1ee11 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 4f64ba243271..b69d93f36a2c 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 000000000000..b1530c1dec91 --- /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@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 fab97890a53c..f0d1e9527540 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 3bdae29e7e9b..c707c5585d15 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 |