mir/libreoffice
2
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
66d19e8f6acda6de9300d86cb15edd2dd5f7228f
libreoffice/wizards/source/access2base/Event.xba
Jean-Pierre Ledure 72a2f615c3 Access2Base Missing parentheses - Bug #106710 
Due to more severe Basic interpreter on final parentheses
missing parentheses were revealed

Change-Id: I779b5e3d299fb9c56ecd807d28a780cc3ab9a1b5
2017-03-25 09:29:02 +01:00

496 lines
22 KiB
XML
Raw Blame History

<?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 &apos; 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 &apos; com.sun.star.awt.MouseButton.XXX
Private _ButtonRight As Boolean
Private _ButtonMiddle As Boolean
Private _XPos As Variant &apos; Null or Long
Private _YPos As Variant &apos; Null or Long
Private _ClickCount As Long
Private _KeyCode As Integer &apos; com.sun.star.awt.Key.XXX
Private _KeyChar As String
Private _KeyFunction As Integer &apos; com.sun.star.awt.KeyFunction.XXX
Private _KeyAlt As Boolean
Private _KeyCtrl As Boolean
Private _KeyShift As Boolean
Private _FocusChangeTemporary As Boolean &apos; False if user action in same window
Private _RowChangeAction As Long &apos; com.sun.star.sdb.RowChangeAction.XXX
Private _Recommendation As String &apos; &quot;IGNORE&quot; or &quot;&quot;
REM -----------------------------------------------------------------------------------------------------------------------
REM --- CONSTRUCTORS / DESTRUCTORS ---
REM -----------------------------------------------------------------------------------------------------------------------
Private Sub Class_Initialize()
_Type = OBJEVENT
_EventSource = Nothing
_EventType = &quot;&quot;
_EventName = &quot;&quot;
_SubComponentName = &quot;&quot;
_SubComponentType = -1
_ContextShortcut = &quot;&quot;
_ButtonLeft = False &apos; See com.sun.star.awt.MouseButton.XXX
_ButtonRight = False
_ButtonMiddle = False
_XPos = Null
_YPos = Null
_ClickCount = 0
_KeyCode = 0
_KeyChar = &quot;&quot;
_KeyFunction = com.sun.star.awt.KeyFunction.DONTKNOW
_KeyAlt = False
_KeyCtrl = False
_KeyShift = False
_FocusChangeTemporary = False
_RowChangeAction = 0
_Recommendation = &quot;&quot;
End Sub &apos; Constructor
REM -----------------------------------------------------------------------------------------------------------------------
Private Sub Class_Terminate()
On Local Error Resume Next
Call Class_Initialize()
End Sub &apos; Destructor
REM -----------------------------------------------------------------------------------------------------------------------
Public Sub Dispose()
Call Class_Terminate()
End Sub &apos; Explicit destructor
REM -----------------------------------------------------------------------------------------------------------------------
REM --- CLASS GET/LET/SET PROPERTIES ---
REM -----------------------------------------------------------------------------------------------------------------------
Property Get ButtonLeft() As Variant
ButtonLeft = _PropertyGet(&quot;ButtonLeft&quot;)
End Property &apos; ButtonLeft (get)
REM -----------------------------------------------------------------------------------------------------------------------
Property Get ButtonMiddle() As Variant
ButtonMiddle = _PropertyGet(&quot;ButtonMiddle&quot;)
End Property &apos; ButtonMiddle (get)
REM -----------------------------------------------------------------------------------------------------------------------
Property Get ButtonRight() As Variant
ButtonRight = _PropertyGet(&quot;ButtonRight&quot;)
End Property &apos; ButtonRight (get)
REM -----------------------------------------------------------------------------------------------------------------------
Property Get ClickCount() As Variant
ClickCount = _PropertyGet(&quot;ClickCount&quot;)
End Property &apos; ClickCount (get)
REM -----------------------------------------------------------------------------------------------------------------------
Property Get ContextShortcut() As Variant
ContextShortcut = _PropertyGet(&quot;ContextShortcut&quot;)
End Property &apos; ContextShortcut (get)
REM -----------------------------------------------------------------------------------------------------------------------
Property Get EventName() As Variant
EventName = _PropertyGet(&quot;EventName&quot;)
End Property &apos; EventName (get)
REM -----------------------------------------------------------------------------------------------------------------------
Property Get EventSource() As Variant
EventSource = _PropertyGet(&quot;EventSource&quot;)
End Property &apos; EventSource (get)
REM -----------------------------------------------------------------------------------------------------------------------
Property Get EventType() As Variant
EventType = _PropertyGet(&quot;EventType&quot;)
End Property &apos; EventType (get)
REM -----------------------------------------------------------------------------------------------------------------------
Property Get FocusChangeTemporary() As Variant
FocusChangeTemporary = _PropertyGet(&quot;FocusChangeTemporary&quot;)
End Property &apos; FocusChangeTemporary (get)
REM -----------------------------------------------------------------------------------------------------------------------
Property Get KeyAlt() As Variant
KeyAlt = _PropertyGet(&quot;KeyAlt&quot;)
End Property &apos; KeyAlt (get)
REM -----------------------------------------------------------------------------------------------------------------------
Property Get KeyChar() As Variant
KeyChar = _PropertyGet(&quot;KeyChar&quot;)
End Property &apos; KeyChar (get)
REM -----------------------------------------------------------------------------------------------------------------------
Property Get KeyCode() As Variant
KeyCode = _PropertyGet(&quot;KeyCode&quot;)
End Property &apos; KeyCode (get)
REM -----------------------------------------------------------------------------------------------------------------------
Property Get KeyCtrl() As Variant
KeyCtrl = _PropertyGet(&quot;KeyCtrl&quot;)
End Property &apos; KeyCtrl (get)
REM -----------------------------------------------------------------------------------------------------------------------
Property Get KeyFunction() As Variant
KeyFunction = _PropertyGet(&quot;KeyFunction&quot;)
End Property &apos; KeyFunction (get)
REM -----------------------------------------------------------------------------------------------------------------------
Property Get KeyShift() As Variant
KeyShift = _PropertyGet(&quot;KeyShift&quot;)
End Property &apos; KeyShift (get)
REM -----------------------------------------------------------------------------------------------------------------------
Property Get ObjectType() As String
ObjectType = _PropertyGet(&quot;ObjectType&quot;)
End Property &apos; ObjectType (get)
REM -----------------------------------------------------------------------------------------------------------------------
Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
&apos; Return
&apos; a Collection object if pvIndex absent
&apos; 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, &quot;&quot;, vPropertiesList)
Else
vProperty = PropertiesGet._Properties(sObject, &quot;&quot;, vPropertiesList, pvIndex)
vProperty._Value = _PropertyGet(vPropertiesList(pvIndex))
End If
Exit_Function:
Set Properties = vProperty
Exit Function
End Function &apos; Properties
REM -----------------------------------------------------------------------------------------------------------------------
Property Get Recommendation() As Variant
Recommendation = _PropertyGet(&quot;Recommendation&quot;)
End Property &apos; Recommendation (get)
REM -----------------------------------------------------------------------------------------------------------------------
Property Get RowChangeAction() As Variant
RowChangeAction = _PropertyGet(&quot;RowChangeAction&quot;)
End Property &apos; RowChangeAction (get)
REM -----------------------------------------------------------------------------------------------------------------------
Public Function Source() As Variant
&apos; Return the object having fired the event: Form, Control or SubForm
&apos; Else return the root Database object
Source = _PropertyGet(&quot;Source&quot;)
End Function &apos; Source (get)
REM -----------------------------------------------------------------------------------------------------------------------
Property Get SubComponentName() As String
SubComponentName = _PropertyGet(&quot;SubComponentName&quot;)
End Property &apos; SubComponentName (get)
REM -----------------------------------------------------------------------------------------------------------------------
Property Get SubComponentType() As Long
SubComponentType = _PropertyGet(&quot;SubComponentType&quot;)
End Property &apos; SubComponentType (get)
REM -----------------------------------------------------------------------------------------------------------------------
Property Get XPos() As Variant
XPos = _PropertyGet(&quot;XPos&quot;)
End Property &apos; XPos (get)
REM -----------------------------------------------------------------------------------------------------------------------
Property Get YPos() As Variant
YPos = _PropertyGet(&quot;YPos&quot;)
End Property &apos; YPos (get)
REM -----------------------------------------------------------------------------------------------------------------------
REM --- CLASS METHODS ---
REM -----------------------------------------------------------------------------------------------------------------------
Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
&apos; Return property value of psProperty property name
Utils._SetCalledSub(&quot;Form.getProperty&quot;)
If IsMissing(pvProperty) Then Call _TraceArguments()
getProperty = _PropertyGet(pvProperty)
Utils._ResetCalledSub(&quot;Form.getProperty&quot;)
End Function &apos; getProperty
REM -----------------------------------------------------------------------------------------------------------------------
Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
&apos; 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 &apos; 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
Const cstDatabaseForm = &quot;com.sun.star.comp.forms.ODatabaseForm&quot;
If _ErrorHandler() Then On Local Error Goto Error_Function
Set oObject = poEvent.Source
_EventSource = oObject
sArray = Split(Utils._getUNOTypeName(poEvent), &quot;.&quot;)
_EventType = UCase(sArray(UBound(sArray)))
If Utils._hasUNOProperty(poEvent, &quot;EventName&quot;) Then _EventName = poEvent.EventName
Select Case _EventType
Case &quot;DOCUMENTEVENT&quot;
&apos;SubComponent processing
Select Case UCase(_EventName)
Case UCase(&quot;OnSubComponentClosed&quot;), UCase(&quot;OnSubComponentOpened&quot;)
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 &quot;EVENTOBJECT&quot;
Case &quot;ACTIONEVENT&quot;
Case &quot;FOCUSEVENT&quot;
_FocusChangeTemporary = poEvent.Temporary
Case &quot;ITEMEVENT&quot;
Case &quot;INPUTEVENT&quot;, &quot;KEYEVENT&quot;
_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 &quot;MOUSEEVENT&quot;
_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 &quot;ROWCHANGEEVENT&quot;
_RowChangeAction = poEvent.Action
Case &quot;TEXTEVENT&quot;
Case &quot;ADJUSTMENTEVENT&quot;, &quot;DOCKINGEVENT&quot;, &quot;ENDDOCKINGEVENT&quot;, &quot;ENDPOPUPMODEEVENT&quot;, &quot;ENHANCEDMOUSEEVENT&quot; _
, &quot;MENUEVENT&quot;, &quot;PAINTEVENT&quot;, &quot;SPINEVENT&quot;, &quot;VCLCONTAINEREVENT&quot;, &quot;WINDOWEVENT&quot;
Goto Exit_Function
Case Else
Goto Exit_Function
End Select
&apos; Evaluate ContextShortcut
sShortcut = &quot;&quot;
sImplementation = Utils._ImplementationName(oObject)
Select Case True
Case sImplementation = &quot;stardiv.Toolkit.UnoDialogControl&quot; &apos; Dialog
_ContextShortcut = &quot;Dialogs!&quot; &amp; _EventSource.Model.Name
Goto Exit_Function
Case Left(sImplementation, 16) = &quot;stardiv.Toolkit.&quot; &apos; Control in Dialog
_ContextShortcut = &quot;Dialogs!&quot; &amp; _EventSource.Context.Model.Name _
&amp; &quot;!&quot; &amp; _EventSource.Model.Name
Goto Exit_Function
Case Else
End Select
iCurrentDoc = _A2B_.CurrentDocIndex(, False)
If iCurrentDoc &lt; 0 Then Goto Exit_Function
Set oDoc = _A2B_.CurrentDocument(iCurrentDoc)
&apos; To manage 2x triggers of &quot;Before record action&quot; form event
If _EventType = &quot;ROWCHANGEEVENT&quot; And sImplementation &lt;&gt; &quot;com.sun.star.comp.forms.ODatabaseForm&quot; Then _Recommendation = &quot;IGNORE&quot;
Do While sImplementation &lt;&gt; &quot;SwXTextDocument&quot;
sAddShortcut = &quot;&quot;
Select Case sImplementation
Case &quot;com.sun.star.comp.forms.OFormsCollection&quot; &apos; Do nothing
Case Else
If Utils._hasUNOProperty(oObject, &quot;Model&quot;) Then
If oObject.Model.Name &lt;&gt; &quot;MainForm&quot; And oObject.Model.Name &lt;&gt; &quot;Form&quot; Then sAddShortcut = Utils._Surround(oObject.Model.Name)
ElseIf Utils._hasUNOProperty(oObject, &quot;Name&quot;) Then
If oObject.Name &lt;&gt; &quot;MainForm&quot; And oObject.Name &lt;&gt; &quot;Form&quot; Then sAddShortcut = Utils._Surround(oObject.Name)
End If
If sAddShortcut &lt;&gt; &quot;&quot; Then
If sImplementation = cstDatabaseForm And oDoc.DbConnect = DBCONNECTBASE Then sAddShortcut = sAddShortcut &amp; &quot;.Form&quot;
sShortcut = sAddShortcut &amp; Iif(Len(sShortcut) &gt; 0, &quot;!&quot; &amp; sShortcut, &quot;&quot;)
End If
End Select
Select Case True
Case Utils._hasUNOProperty(oObject, &quot;Model&quot;)
Set oObject = oObject.Model.Parent
Case Utils._hasUNOProperty(oObject, &quot;Parent&quot;)
Set oObject = oObject.Parent
Case Else
Goto Exit_Function
End Select
sImplementation = Utils._ImplementationName(oObject)
Loop
&apos; Add Forms! prefix
&apos; Select Case oDoc.DbConnect
&apos; Case DBCONNECTBASE
If Utils._hasUNOProperty(oObject, &quot;Args&quot;) Then &apos; Current object is a SwXTextDocument
For i = 0 To UBound(oObject.Args)
If oObject.Args(i).Name = &quot;DocumentTitle&quot; Then
sAddShortcut = Utils._Surround(oObject.Args(i).Value)
Exit For
End If
Next i
End If
sShortcut = &quot;Forms!&quot; &amp; sAddShortcut &amp; &quot;!&quot; &amp; sShortcut
&apos; Case DBCONNECTFORM
&apos; sShortcut = &quot;Forms!0!&quot; &amp; sShortcut
&apos; End Select
sArray = Split(sShortcut, &quot;!&quot;)
&apos; If presence of &quot;Forms!myform!myform.Form&quot;, eliminate 2nd element
&apos; Eliminate anyway blanco subcomponents (e.g; Forms!!myForm)
If UBound(sArray) &gt;= 2 Then
If UCase(sArray(1)) &amp; &quot;.FORM&quot; = UCase(sArray(2)) Then sArray(1) = &quot;&quot;
sArray = Utils._TrimArray(sArray)
End If
&apos; If first element ends with .Form, remove suffix
If UBound(sArray) &gt;= 1 Then
If Len(sArray(1)) &gt; 5 And Right(sArray(1), 5) = &quot;.Form&quot; Then sArray(1) = left(sArray(1), Len(sArray(1)) - 5)
sShortcut = Join(sArray, &quot;!&quot;)
End If
If Len(sShortcut) &gt;= 2 Then
If Right(sShortcut, 1) = &quot;!&quot; Then
_ContextShortcut = Left(sShortcut, Len(sShortcut) - 1)
Else
_ContextShortcut = sShortcut
End If
End If
Exit_Function:
Exit Sub
Error_Function:
TraceError(TRACEWARNING, Err, &quot;Event.Initialize&quot;, Erl)
GoTo Exit_Function
End Sub &apos; _Initialize V0.9.1
REM -----------------------------------------------------------------------------------------------------------------------
Private Function _PropertiesList() As Variant
Dim sSubComponentName As String, sSubComponentType As String
sSubComponentName = Iif(_SubComponentType &gt; -1, &quot;SubComponentName&quot;, &quot;&quot;)
sSubComponentType = Iif(_SubComponentType &gt; -1, &quot;SubComponentType&quot;, &quot;&quot;)
Dim sXPos As String, sYPos As String
sXPos = Iif(IsNull(_XPos), &quot;&quot;, &quot;XPos&quot;)
sYPos = Iif(IsNull(_YPos), &quot;&quot;, &quot;YPos&quot;)
_PropertiesList = Utils._TrimArray(Array( _
&quot;ButtonLeft&quot;, &quot;ButtonRight&quot;, &quot;ButtonMiddle&quot;, &quot;ClickCount&quot; _
, &quot;ContextShortcut&quot;, &quot;EventName&quot;, &quot;EventType&quot;, &quot;FocusChangeTemporary&quot;, _
, &quot;KeyAlt&quot;, &quot;KeyChar&quot;, &quot;KeyCode&quot;, &quot;KeyCtrl&quot;, &quot;KeyFunction&quot;, &quot;KeyShift&quot; _
, &quot;ObjectType&quot;, &quot;Recommendation&quot;, &quot;RowChangeAction&quot;, &quot;Source&quot; _
, sSubComponentName, sSubComponentType, sXPos, sYPos _
))
End Function &apos; _PropertiesList
REM -----------------------------------------------------------------------------------------------------------------------
Private Function _PropertyGet(ByVal psProperty As String) As Variant
&apos; Return property value of the psProperty property name
If _ErrorHandler() Then On Local Error Goto Error_Function
Utils._SetCalledSub(&quot;Event.get&quot; &amp; psProperty)
_PropertyGet = EMPTY
Select Case UCase(psProperty)
Case UCase(&quot;ButtonLeft&quot;)
_PropertyGet = _ButtonLeft
Case UCase(&quot;ButtonMiddle&quot;)
_PropertyGet = _ButtonMiddle
Case UCase(&quot;ButtonRight&quot;)
_PropertyGet = _ButtonRight
Case UCase(&quot;ClickCount&quot;)
_PropertyGet = _ClickCount
Case UCase(&quot;ContextShortcut&quot;)
_PropertyGet = _ContextShortcut
Case UCase(&quot;FocusChangeTemporary&quot;)
_PropertyGet = _FocusChangeTemporary
Case UCase(&quot;EventName&quot;)
_PropertyGet = _EventName
Case UCase(&quot;EventSource&quot;)
_PropertyGet = _EventSource
Case UCase(&quot;EventType&quot;)
_PropertyGet = _EventType
Case UCase(&quot;KeyAlt&quot;)
_PropertyGet = _KeyAlt
Case UCase(&quot;KeyChar&quot;)
_PropertyGet = _KeyChar
Case UCase(&quot;KeyCode&quot;)
_PropertyGet = _KeyCode
Case UCase(&quot;KeyCtrl&quot;)
_PropertyGet = _KeyCtrl
Case UCase(&quot;KeyFunction&quot;)
_PropertyGet = _KeyFunction
Case UCase(&quot;KeyShift&quot;)
_PropertyGet = _KeyShift
Case UCase(&quot;ObjectType&quot;)
_PropertyGet = _Type
Case UCase(&quot;Recommendation&quot;)
_PropertyGet = _Recommendation
Case UCase(&quot;RowChangeAction&quot;)
_PropertyGet = _RowChangeAction
Case UCase(&quot;Source&quot;)
If _ContextShortcut = &quot;&quot; Then
_PropertyGet = _EventSource
Else
_PropertyGet = getObject(_ContextShortcut)
End If
Case UCase(&quot;SubComponentName&quot;)
_PropertyGet = _SubComponentName
Case UCase(&quot;SubComponentType&quot;)
_PropertyGet = _SubComponentType
Case UCase(&quot;XPos&quot;)
If IsNull(_XPos) Then Goto Trace_Error
_PropertyGet = _XPos
Case UCase(&quot;YPos&quot;)
If IsNull(_YPos) Then Goto Trace_Error
_PropertyGet = _YPos
Case Else
Goto Trace_Error
End Select
Exit_Function:
Utils._ResetCalledSub(&quot;Event.get&quot; &amp; psProperty)
Exit Function
Trace_Error:
&apos; 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, &quot;Event._PropertyGet&quot;, Erl)
_PropertyGet = EMPTY
GoTo Exit_Function
End Function &apos; _PropertyGet V1.1.0
</script:module>
Reference in New Issue View Git Blame Copy Permalink