<?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)
Dim vEMPTY As Variant
	_PropertyGet = vEMPTY
	
	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 = vEMPTY
	Goto Exit_Function
Error_Function:
	TraceError(TRACEABORT, Err, &quot;Event._PropertyGet&quot;, Erl)
	_PropertyGet = vEMPTY
	GoTo Exit_Function
End Function		&apos;	_PropertyGet	V1.1.0
</script:module>