Adding upstream version 4:7.4.7.upstream/4%7.4.7upstream

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

1 files changed, 300 insertions, 0 deletions

diff --git a/wizards/source/access2base/Methods.xba b/wizards/source/access2base/Methods.xba
new file mode 100644
index 000000000..7f809c6c1
--- /dev/null
+++ b/wizards/source/access2base/Methods.xba
@@ -0,0 +1,300 @@
+<?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="Methods" 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 Explicit
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function AddItem(Optional pvBox As Variant, ByVal Optional pvItem As Variant, ByVal Optional pvIndex) As Boolean
+&apos;	Add an item in a Listbox
+
+	Utils._SetCalledSub(&quot;AddItem&quot;)
+	If _ErrorHandler() Then On Local Error Goto Error_Function
+	
+	If IsMissing(pvBox) Or IsMissing(pvItem) Then Call _TraceArguments()
+	If IsMissing(pvIndex) Then pvIndex = -1
+	If Not Utils._CheckArgument(pvBox, 1, Array(CTLLISTBOX, CTLCOMBOBOX)) Then Goto Exit_Function
+
+	AddItem = pvBox.AddItem(pvItem, pvIndex)
+
+Exit_Function:
+	Utils._ResetCalledSub(&quot;AddItem&quot;)
+	Exit Function
+Error_Function:
+	TraceError(TRACEABORT, Err, &quot;AddItem&quot;, Erl)
+	AddItem = False
+	GoTo Exit_Function
+End Function		&apos;	AddItem		V0.9.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function hasProperty(Optional pvObject As Variant, ByVal Optional pvProperty As Variant) As Boolean
+&apos;	Return True if pvObject has a valid property called pvProperty (case-insensitive comparison !)
+
+Dim vPropertiesList As Variant
+
+	Utils._SetCalledSub(&quot;hasProperty&quot;)
+	If IsMissing(pvObject) Or IsMissing(pvProperty) Then Call _TraceArguments()
+	
+	hasProperty = False
+	If Not Utils._CheckArgument(pvObject, 1, Array(OBJCOLLECTION, OBJFORM, OBJSUBFORM, OBJCONTROL, OBJOPTIONGROUP, OBJEVENT _
+						, OBJPROPERTY, OBJDATABASE, OBJQUERYDEF, OBJTABLEDEF, OBJRECORDSET _
+						)) Then Goto Exit_Function
+	If Not Utils._CheckArgument(pvProperty, 2, vbString) Then Goto Exit_Function
+	
+	hasProperty = pvObject.hasProperty(pvProperty)
+
+Exit_Function:
+	Utils._ResetCalledSub(&quot;hasProperty&quot;)
+	Exit Function
+End Function	&apos;	hasProperty		V0.9.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function Move(Optional pvObject As Object _
+						, ByVal Optional pvLeft As Variant _
+						, ByVal Optional pvTop As Variant _
+						, ByVal Optional pvWidth As Variant _
+						, ByVal Optional pvHeight As Variant _
+						) As Variant
+&apos;	Execute Move method
+	Utils._SetCalledSub(&quot;Move&quot;)
+	If IsMissing(pvObject) Then Call _TraceArguments()
+	If _ErrorHandler() Then On Local Error Goto Error_Function
+	Move = False
+	If Not Utils._CheckArgument(pvObject,	1, Array(OBJFORM, OBJDIALOG)) Then Goto Exit_Function	
+	If IsMissing(pvLeft) Then Call _TraceArguments()
+	If IsMissing(pvTop) Then pvTop = -1
+	If IsMissing(pvWidth) Then pvWidth = -1
+	If IsMissing(pvHeight) Then pvHeight = -1
+
+	Move = pvObject.Move(pvLeft, pvTop, pvWidth, pvHeight)
+	
+Exit_Function:
+	Utils._ResetCalledSub(&quot;Move&quot;)
+	Exit Function
+Error_Function:
+	TraceError(TRACEABORT, Err, &quot;Move&quot;, Erl)
+	GoTo Exit_Function
+End Function		&apos;	Move	V.0.9.1
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function OpenHelpFile()
+&apos;	Open the help file from the Help menu (IDE only)
+Const cstHelpFile = &quot;http://www.access2base.com/access2base.html&quot;
+
+	On Local Error Resume Next
+	Call _ShellExecute(cstHelpFile)
+	
+End Function	&apos;	OpenHelpFile	V0.8.5
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function Properties(Optional pvObject As Variant, ByVal Optional pvIndex As Variant) As Variant
+&apos;	Return
+&apos;		a Collection object if pvIndex absent
+&apos;		a Property object otherwise
+
+Dim vProperties As Variant, oCounter As Variant, opProperty As Variant
+Dim vPropertiesList() As Variant
+	
+	If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments()
+	Utils._SetCalledSub(&quot;Properties&quot;)
+	
+	Set vProperties = Nothing
+	If Not Utils._CheckArgument(pvObject, 1, Array(OBJCOLLECTION, OBJFORM, OBJSUBFORM, OBJCONTROL, OBJOPTIONGROUP, OBJEVENT _
+						, OBJPROPERTY, OBJDATABASE, OBJQUERYDEF, OBJTABLEDEF, OBJRECORDSET _
+						)) Then Goto Exit_Function
+
+	If IsMissing(pvIndex) Then vProperties = pvObject.Properties Else vProperties = pvObject.Properties(pvIndex)
+				
+Exit_Function:
+	Set Properties = vProperties
+	Utils._ResetCalledSub(&quot;Properties&quot;)
+	Exit Function
+End Function		&apos;	Properties	V0.9.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function Refresh(Optional pvObject As Variant) As Boolean
+&apos;	Refresh data with its most recent value in the database in a form or subform
+	Utils._SetCalledSub(&quot;Refresh&quot;)
+	If IsMissing(pvObject) Then Call _TraceArguments()
+	If _ErrorHandler() Then On Local Error Goto Error_Function
+	Refresh = False
+	If Not Utils._CheckArgument(pvObject, 1, Array(OBJFORM, OBJSUBFORM)) Then Goto Exit_Function
+
+	Refresh = pvObject.Refresh()
+
+Exit_Function:
+	Utils._ResetCalledSub(&quot;Refresh&quot;)
+	Exit Function
+Error_Function:
+	TraceError(TRACEABORT, Err, &quot;Refresh&quot;, Erl)
+	GoTo Exit_Function
+End Function	&apos;	Refresh		V0.9.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function RemoveItem(Optional pvBox As Variant,ByVal Optional pvIndex) As Boolean
+&apos;	Remove an item from a Listbox
+&apos;	Index may be a string value or an index-position
+
+	Utils._SetCalledSub(&quot;RemoveItem&quot;)
+	If _ErrorHandler() Then On Local Error Goto Error_Function
+	
+	If IsMissing(pvBox) Or IsMissing(pvIndex) Then Call _TraceArguments()
+	If Not Utils._CheckArgument(pvBox, 1, Array(CTLLISTBOX, CTLCOMBOBOX)) Then Goto Exit_Function
+	
+	RemoveItem = pvBox.RemoveItem(pvIndex)
+
+Exit_Function:
+	Utils._ResetCalledSub(&quot;RemoveItem&quot;)
+	Exit Function
+Error_Function:
+	TraceError(TRACEABORT, Err, &quot;RemoveItem&quot;, Erl)
+	RemoveItem = False
+	GoTo Exit_Function
+End Function		&apos;	RemoveItem		V0.9.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function Requery(Optional pvObject As Variant) As Boolean
+&apos;	Refresh data displayed in a form, subform, combobox or listbox
+	Utils._SetCalledSub(&quot;Requery&quot;)
+	If IsMissing(pvObject) Then Call _TraceArguments()
+	If _ErrorHandler() Then On Local Error Goto Error_Function
+	If Not Utils._CheckArgument(pvObject, 1, Array(OBJFORM, OBJCONTROL, OBJSUBFORM)) Then Goto Exit_Function
+	
+	Requery = pvObject.Requery()
+
+Exit_Function:
+	Utils._ResetCalledSub(&quot;Requery&quot;)
+	Exit Function
+Error_Function:
+	TraceError(TRACEABORT, Err, &quot;Requery&quot;, Erl)
+	GoTo Exit_Function
+End Function	&apos;	Requery		V0.9.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function SetFocus(Optional pvObject As Variant) As Boolean
+&apos;	Execute SetFocus method
+	Utils._SetCalledSub(&quot;setFocus&quot;)
+	If IsMissing(pvObject) Then Call _TraceArguments()
+	If _ErrorHandler() Then On Local Error Goto Error_Function
+	If Not Utils._CheckArgument(pvObject, 1, Array(OBJFORM, OBJCONTROL)) Then Goto Exit_Function	
+
+	SetFocus = pvObject.setFocus()
+	
+Exit_Function:
+	Utils._ResetCalledSub(&quot;SetFocus&quot;)
+	Exit Function
+Error_Function:
+	TraceError(TRACEABORT, Err, &quot;SetFocus&quot;, Erl)
+	Goto Exit_Function
+Error_Grid:
+	TraceError(TRACEFATAL, ERRFOCUSINGRID, Utils._CalledSub(), 0, 1, Array(pvObject._Name, ocGrid._Name))
+	Goto Exit_Function
+End Function	&apos;	SetFocus	V0.9.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
+REM --- PRIVATE FUNCTIONS 								        														---
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function _OptionGroup(ByVal pvGroupName As Variant _
+					, ByVal psParentType As String _
+					, poComponent As Object _
+					, poParent As Object _
+					) As Variant
+&apos;	Return either an error or an object of type OPTIONGROUP based on its name
+
+	If IsMissing(pvGroupName) Then Call _TraceArguments()
+	If _ErrorHandler() Then On Local Error Goto Error_Function
+	Set _OptionGroup = Nothing
+	
+	If Not Utils._CheckArgument(pvGroupName, 1, vbString) Then Goto Exit_Function
+
+Dim ogGroup As Variant, i As Integer, j As Integer, bFound As Boolean
+Dim vOptionButtons() As Variant, sGroupName As String
+Dim lXY() As Long, iIndex() As Integer		&apos;	Two indexes X-Y coordinates
+Dim oView As Object, oDatabaseForm As Object, vControls As Variant
+
+Const cstPixels = 10							&apos;	Tolerance on coordinates when drawn approximately
+
+	bFound = False
+	Select Case psParentType
+		Case CTLPARENTISFORM
+			&apos;poParent is a forms collection, find the appropriate database form
+			For i = 0 To poParent.Count - 1
+				Set oDatabaseForm = poParent.getByIndex(i)
+				If Not IsNull(oDatabaseForm) Then
+					For j = 0 To oDatabaseForm.GroupCount - 1		&apos;	Does a group with the right name exist ?
+						oDatabaseForm.getGroup(j, vOptionButtons, sGroupName)
+						If UCase(sGroupName) = UCase(Utils._Trim(pvGroupName)) Then
+							bFound = True
+							Exit For
+						End If
+					Next j
+					If bFound Then Exit For
+				End If
+				If bFound Then Exit For
+			Next i
+		Case CTLPARENTISSUBFORM
+			&apos;poParent is already a database form
+			Set oDatabaseForm = poParent
+			For j = 0 To oDatabaseForm.GroupCount - 1		&apos;	Does a group with the right name exist ?
+				oDatabaseForm.getGroup(j, vOptionButtons, sGroupName)
+				If UCase(sGroupName) = UCase(Utils._Trim(pvGroupName)) Then
+					bFound = True
+					Exit For
+				End If
+			Next j
+	End Select
+
+	If bFound Then
+
+		ogGroup = New Optiongroup
+		ogGroup._This = ogGroup
+		ogGroup._Name = sGroupName
+		ogGroup._ButtonsGroup = vOptionButtons
+		ogGroup._Count = UBound(vOptionButtons) + 1
+		ogGroup._ParentType = psParentType
+		ogGroup._MainForm = oDatabaseForm.Name
+		Set ogGroup._ParentComponent = poComponent
+
+		ReDim lXY(1, ogGroup._Count - 1)
+		ReDim iIndex(ogGroup._Count - 1)
+		For i = 0 To ogGroup._Count - 1			&apos;	Find the position of each radiobutton
+			Set oView = poComponent.CurrentController.getControl(ogGroup._ButtonsGroup(i))
+			lXY(0, i) = oView.PosSize.X
+			lXY(1, i) = oView.PosSize.Y
+		Next i
+		For i = 0 To ogGroup._Count - 1			&apos;	Sort them on XY coordinates		
+			If i = 0 Then
+				iIndex(0) = 0
+			Else
+				iIndex(i) = i
+				For j = i - 1 To 0 Step -1
+					If lXY(1, i) - lXY(1, j) &lt; - cstPixels Or ( Abs(lXY(1, i) - lXY(1, j)) &lt;= cstPixels And lXY(0, i) - lXY(0, j) &lt; - cstPixels ) Then
+						iIndex(i) = iIndex(j)
+						iIndex(j) = iIndex(j) + 1
+					End If
+				Next j
+			End If
+		Next i
+		ogGroup._ButtonsIndex = iIndex()
+
+		Set _OptionGroup = ogGroup
+
+	Else
+
+		Set _OptionGroup = Nothing
+		TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, , Array(1, pvGroupName))
+
+	End If
+	
+Exit_Function:
+	Exit Function
+Error_Function:
+	TraceError(TRACEABORT, Err,&quot;_OptionGroup&quot;, Erl)
+	GoTo Exit_Function
+End Function		&apos;	_OptionGroup	V1.1.0
+
+</script:module>
\ No newline at end of file