diff options
Diffstat (limited to 'wizards/source/access2base/CommandBar.xba')
| -rw-r--r-- | wizards/source/access2base/CommandBar.xba | 396 |
1 files changed, 396 insertions, 0 deletions
diff --git a/wizards/source/access2base/CommandBar.xba b/wizards/source/access2base/CommandBar.xba new file mode 100644 index 000000000..c30f696fb --- /dev/null +++ b/wizards/source/access2base/CommandBar.xba @@ -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>
\ No newline at end of file |