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