diff options
Diffstat (limited to 'wizards/source/access2base/Dialog.xba')
| -rw-r--r-- | wizards/source/access2base/Dialog.xba | 818 |
1 files changed, 818 insertions, 0 deletions
diff --git a/wizards/source/access2base/Dialog.xba b/wizards/source/access2base/Dialog.xba new file mode 100644 index 0000000000..69caed33cc --- /dev/null +++ b/wizards/source/access2base/Dialog.xba @@ -0,0 +1,818 @@ +<?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="Dialog" 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 DIALOG +Private _This As Object ' Workaround for absence of This builtin function +Private _Parent As Object +Private _Name As String +Private _Shortcut As String +Private _Dialog As Object ' com.sun.star.io.XInputStreamProvider +Private _Storage As String ' GLOBAL or DOCUMENT +Private _Library As String +Private UnoDialog As Object ' com.sun.star.awt.XControl + +REM ----------------------------------------------------------------------------------------------------------------------- +REM --- CONSTRUCTORS / DESTRUCTORS --- +REM ----------------------------------------------------------------------------------------------------------------------- +Private Sub Class_Initialize() + _Type = OBJDIALOG + Set _This = Nothing + Set _Parent = Nothing + _Name = "" + Set _Dialog = Nothing + _Storage = "" + _Library = "" + Set UnoDialog = Nothing +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 Caption() As Variant + Caption = _PropertyGet("Caption") +End Property ' Caption (get) + +Property Let Caption(ByVal pvValue As Variant) + Call _PropertySet("Caption", pvValue) +End Property ' Caption (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get Height() As Variant + Height = _PropertyGet("Height") +End Property ' Height (get) + +Property Let Height(ByVal pvValue As Variant) + Call _PropertySet("Height", pvValue) +End Property ' Height (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get IsLoaded() As Boolean + IsLoaded = _PropertyGet("IsLoaded") +End Property + +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 ----------------------------------------------------------------------------------------------------------------------- +Property Get OnFocusGained() As Variant + OnFocusGained = _PropertyGet("OnFocusGained") +End Property ' OnFocusGained (get) + +Property Let OnFocusGained(ByVal pvValue As Variant) + Call _PropertySet("OnFocusGained", pvValue) +End Property ' OnFocusGained (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get OnFocusLost() As Variant + OnFocusLost = _PropertyGet("OnFocusLost") +End Property ' OnFocusLost (get) + +Property Let OnFocusLost(ByVal pvValue As Variant) + Call _PropertySet("OnFocusLost", pvValue) +End Property ' OnFocusLost (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get OnKeyPressed() As Variant + OnKeyPressed = _PropertyGet("OnKeyPressed") +End Property ' OnKeyPressed (get) + +Property Let OnKeyPressed(ByVal pvValue As Variant) + Call _PropertySet("OnKeyPressed", pvValue) +End Property ' OnKeyPressed (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get OnKeyReleased() As Variant + OnKeyReleased = _PropertyGet("OnKeyReleased") +End Property ' OnKeyReleased (get) + +Property Let OnKeyReleased(ByVal pvValue As Variant) + Call _PropertySet("OnKeyReleased", pvValue) +End Property ' OnKeyReleased (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get OnMouseDragged() As Variant + OnMouseDragged = _PropertyGet("OnMouseDragged") +End Property ' OnMouseDragged (get) + +Property Let OnMouseDragged(ByVal pvValue As Variant) + Call _PropertySet("OnMouseDragged", pvValue) +End Property ' OnMouseDragged (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get OnMouseEntered() As Variant + OnMouseEntered = _PropertyGet("OnMouseEntered") +End Property ' OnMouseEntered (get) + +Property Let OnMouseEntered(ByVal pvValue As Variant) + Call _PropertySet("OnMouseEntered", pvValue) +End Property ' OnMouseEntered (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get OnMouseExited() As Variant + OnMouseExited = _PropertyGet("OnMouseExited") +End Property ' OnMouseExited (get) + +Property Let OnMouseExited(ByVal pvValue As Variant) + Call _PropertySet("OnMouseExited", pvValue) +End Property ' OnMouseExited (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get OnMouseMoved() As Variant + OnMouseMoved = _PropertyGet("OnMouseMoved") +End Property ' OnMouseMoved (get) + +Property Let OnMouseMoved(ByVal pvValue As Variant) + Call _PropertySet("OnMouseMoved", pvValue) +End Property ' OnMouseMoved (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get OnMousePressed() As Variant + OnMousePressed = _PropertyGet("OnMousePressed") +End Property ' OnMousePressed (get) + +Property Let OnMousePressed(ByVal pvValue As Variant) + Call _PropertySet("OnMousePressed", pvValue) +End Property ' OnMousePressed (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get OnMouseReleased() As Variant + OnMouseReleased = _PropertyGet("OnMouseReleased") +End Property ' OnMouseReleased (get) + +Property Let OnMouseReleased(ByVal pvValue As Variant) + Call _PropertySet("OnMouseReleased", pvValue) +End Property ' OnMouseReleased (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Public Function OptionGroup(ByVal Optional pvGroupName As Variant) As Variant +' Return either an error or an object of type OPTIONGROUP based on its name +' A group is determined by the successive TabIndexes of the radio button +' The name of the group = the name of its first element + + Utils._SetCalledSub("Dialog.OptionGroup") + 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 iAllCount As Integer, iRadioLast As Integer, iGroupCount As Integer, iBegin As Integer, iEnd As Integer +Dim oRadios() As Object, sGroupName As String +Dim i As Integer, j As Integer, bFound As Boolean, ocControl As Object, oRadio As Object, iTabIndex As Integer +Dim ogGroup As Object, vGroup() As Variant, vIndex() As Variant + iAllCount = Controls.Count + If iAllCount > 0 Then + iRadioLast = -1 + ReDim oRadios(0 To iAllCount - 1) + For i = 0 To iAllCount - 1 ' Store all RadioButtons objects + Set ocControl = Controls(i) + If ocControl._SubType = CTLRADIOBUTTON Then + iRadioLast = iRadioLast + 1 + Set oRadios(iRadioLast) = ocControl + End If + Next i + Else + Goto Error_Arg ' No control in dialog + End If + + If iRadioLast < 0 then Goto Error_Arg ' No radio buttons in the dialog + + 'Resort oRadio array based on tab indexes + If iRadioLast > 0 Then + For i = 0 To iRadioLast - 1 ' Bubble sort + For j = i + 1 To iRadioLast + If oRadios(i).TabIndex > oRadios(j).TabIndex Then + Set oRadio = oRadios(i) + Set oRadios(i) = oRadios(j) + Set oRadios(j) = oRadio + End If + Next j + Next i + End If + + 'Scan Names to find match with argument + bFound = False + For i = 0 To iRadioLast + If UCase(oRadios(i)._Name) = UCase(pvGroupName) Then + Select Case i + Case 0 : bFound = True + Case Else + If oRadios(i).TabIndex > oRadios(i - 1).TabIndex + 1 Then + bFound = True + Else + Goto Error_Arg ' same group as preceding item although name correct + End If + End Select + If bFound Then + iBegin = i + iEnd = i + sGroupName = oRadios(i)._Name + End If + ElseIf bFound Then + If oRadios(i).TabIndex = oRadios(i - 1).TabIndex + 1 Then iEnd = i + End If + Next i + + If bFound Then ' Create OptionGroup + iGroupCount = iEnd - iBegin + 1 + Set ogGroup = New OptionGroup + ReDim vGroup(0 To iGroupCount - 1) + ReDim vIndex(0 To iGroupCount - 1) + With ogGroup + ._This = ogGroup + ._Name = sGroupName + ._Count = iGroupCount + ._ButtonsGroup = vGroup + ._ButtonsIndex = vIndex + For i = 0 To iGroupCount - 1 + Set ._ButtonsGroup(i) = oRadios(iBegin + i).ControlModel + ._ButtonsIndex(i) = i + Next i + ._ParentType = CTLPARENTISDIALOG + ._ParentComponent = UnoDialog + End With + Else Goto Error_Arg + End If + + Set OptionGroup = ogGroup + +Exit_Function: + Utils._ResetCalledSub("Dialog.OptionGroup") + Exit Function +Error_Arg: + TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, , Array(1, pvGroupName)) + Goto Exit_Function +Error_Function: + TraceError(TRACEABORT, Err, "Dialog.OptionGroup", Erl) + GoTo Exit_Function +End Function ' OptionGroup V0.9.1 + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get Page() As Variant + Page = _PropertyGet("Page") +End Property ' Page (get) + +Property Let Page(ByVal pvValue As Variant) + Call _PropertySet("Page", pvValue) +End Property ' Page (set) + +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 + +Const cstThisSub = "Dialog.Properties" + Utils._SetCalledSub(cstThisSub) + +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 + Utils._ResetCalledSub(cstThisSub) + 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 ----------------------------------------------------------------------------------------------------------------------- +Property Get Width() As Variant + Width = _PropertyGet("Width") +End Property ' Width (get) + +Property Let Width(ByVal pvValue As Variant) + Call _PropertySet("Width", pvValue) +End Property ' Width (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +REM --- CLASS METHODS --- +REM ----------------------------------------------------------------------------------------------------------------------- + +Public Function Controls(Optional ByVal pvIndex As Variant) As Variant +' Return a Control object with name or index = pvIndex + +If _ErrorHandler() Then On Local Error Goto Error_Function + Utils._SetCalledSub("Dialog.Controls") + +Dim ocControl As Variant, sParentShortcut As String, iControlCount As Integer +Dim oCounter As Variant, sControls() As Variant, i As Integer, bFound As Boolean, sIndex As String +Dim j As Integer + + Set ocControl = Nothing + If Not IsLoaded Then Goto Trace_Error_NotOpen + Set ocControl = New Control + Set ocControl._This = ocControl + Set ocControl._Parent = _This + ocControl._ParentType = CTLPARENTISDIALOG + sParentShortcut = _Shortcut + sControls() = UnoDialog.Model.getElementNames() + iControlCount = UBound(sControls) + 1 + + If IsMissing(pvIndex) Then ' No argument, return Collection object + Set oCounter = New Collect + Set oCounter._This = oCounter + oCounter._CollType = COLLCONTROLS + oCounter._Count = iControlCount + Set oCounter._Parent = _This + Set Controls = oCounter + Goto Exit_Function + End If + + If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function + + ' Start building the ocControl object + ' Determine exact name + + Select Case VarType(pvIndex) + Case vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbBigint, vbDecimal + If pvIndex < 0 Or pvIndex > iControlCount - 1 Then Goto Trace_Error_Index + ocControl._Name = sControls(pvIndex) + Case vbString ' Check control name validity (non case sensitive) + bFound = False + sIndex = UCase(Utils._Trim(pvIndex)) + For i = 0 To iControlCount - 1 + If UCase(sControls(i)) = sIndex Then + bFound = True + Exit For + End If + Next i + If bFound Then ocControl._Name = sControls(i) Else Goto Trace_NotFound + End Select + + ocControl._Shortcut = sParentShortcut & "!" & Utils._Surround(ocControl._Name) + Set ocControl.ControlModel = UnoDialog.Model.getByName(ocControl._Name) + Set ocControl.ControlView = UnoDialog.getControl(ocControl._Name) + ocControl._ImplementationName = ocControl.ControlModel.getImplementationName() + ocControl._FormComponent = UnoDialog + + ocControl._Initialize() + Set Controls = ocControl + +Exit_Function: + Utils._ResetCalledSub("Dialog.Controls") + Exit Function +Trace_Error: + TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, , Array(iArg, pvIndex)) + Set Controls = Nothing + Goto Exit_Function +Trace_Error_NotOpen: + TraceError(TRACEFATAL, ERRDIALOGNOTSTARTED, Utils._CalledSub(), 0, , _Name) + Set Controls = Nothing + Goto Exit_Function +Trace_Error_Index: + TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0, 1) + Set Controls = Nothing + Goto Exit_Function +Trace_NotFound: + TraceError(TRACEFATAL, ERRCONTROLNOTFOUND, Utils._CalledSub(), 0, , Array(pvIndex, pvIndex)) + Set Controls = Nothing + Goto Exit_Function +Error_Function: + TraceError(TRACEABORT, Err, "Dialog.Controls", Erl) + Set Controls = Nothing + GoTo Exit_Function +End Function ' Controls + +REM ----------------------------------------------------------------------------------------------------------------------- +Public Sub EndExecute(ByVal Optional pvReturn As Variant) +' Stop executing the dialog + +If _ErrorHandler() Then On Local Error Goto Error_Sub + Utils._SetCalledSub("Dialog.endExecute") + + If IsMissing(pvReturn) Then pvReturn = 0 + If Not Utils._CheckArgument(pvReturn, 1, Utils._AddNumeric(), , False) Then Goto Trace_Error + +Dim lExecute As Long + lExecute = CLng(pvReturn) + If IsNull(_Dialog) Then Goto Error_Execute + If IsNull(UnoDialog) Then Goto Error_Not_Started + Call UnoDialog.endDialog(lExecute) + +Exit_Sub: + Utils._ResetCalledSub("Dialog.endExecute") + Exit Sub +Trace_Error: + TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, , Array("1", Utils._CStr(pvReturn))) + Goto Exit_Sub +Error_Execute: + TraceError(TRACEFATAL, ERRDIALOGUNDEFINED, Utils._CalledSub(), 0) + Goto Exit_Sub +Error_Not_Started: + TraceError(TRACEWARNING, ERRDIALOGNOTSTARTED, Utils._CalledSub(), 0, 1, _Name) + Goto Exit_Sub +Error_Sub: + TraceError(TRACEABORT, Err, "Dialog.endExecute", Erl) + GoTo Exit_Sub +End Sub ' EndExecute + +REM ----------------------------------------------------------------------------------------------------------------------- +Public Function Execute() As Long +' Execute dialog + +'If _ErrorHandler() Then On Local Error Goto Error_Function +'Seems smart not to trap errors: debugging of dialog events otherwise made very difficult ! + Utils._SetCalledSub("Dialog.Execute") + +Dim lExecute As Long + If IsNull(_Dialog) Then Goto Error_Execute + If IsNull(UnoDialog) Then Goto Error_Not_Started + lExecute = UnoDialog.execute() + + Select Case lExecute + Case 1 : Execute = dlgOK + Case 0 : Execute = dlgCancel + Case Else : Execute = lExecute + End Select + +Exit_Function: + Utils._ResetCalledSub("Dialog.Execute") + Exit Function +Error_Execute: + TraceError(TRACEFATAL, ERRDIALOGUNDEFINED, Utils._CalledSub(), 0) + Goto Exit_Function +Error_Not_Started: + TraceError(TRACEWARNING, ERRDIALOGNOTSTARTED, Utils._CalledSub(), 0, 1, _Name) + Goto Exit_Function +Error_Function: + TraceError(TRACEABORT, Err, "Dialog.Execute", Erl) + GoTo Exit_Function +End Function ' Execute + +REM ----------------------------------------------------------------------------------------------------------------------- +Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant +' Return property value of psProperty property name + + Utils._SetCalledSub("Dialog.getProperty") + If IsMissing(pvProperty) Then Call _TraceArguments() + getProperty = _PropertyGet(pvProperty) + Utils._ResetCalledSub("Dialog.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 Move( ByVal Optional pvLeft As Variant _ + , ByVal Optional pvTop As Variant _ + , ByVal Optional pvWidth As Variant _ + , ByVal Optional pvHeight As Variant _ + ) As Variant +' Execute Move method + Utils._SetCalledSub("Dialog.Move") + On Local Error Goto Error_Function + Move = False +Dim iArgNr As Integer + Select Case UCase(_A2B_.CalledSub) + Case UCase("Move") : iArgNr = 1 + Case UCase("Dialog.Move") : iArgNr = 0 + End Select + If IsMissing(pvLeft) Then pvLeft = -1 + If IsMissing(pvTop) Then pvTop = -1 + If IsMissing(pvWidth) Then pvWidth = -1 + If IsMissing(pvHeight) Then pvHeight = -1 + If Not Utils._CheckArgument(pvLeft, iArgNr + 1, Utils._AddNumeric()) Then Goto Exit_Function + If Not Utils._CheckArgument(pvTop, iArgNr + 2, Utils._AddNumeric()) Then Goto Exit_Function + If Not Utils._CheckArgument(pvWidth, iArgNr + 3, Utils._AddNumeric()) Then Goto Exit_Function + If Not Utils._CheckArgument(pvHeight, iArgNr + 4, Utils._AddNumeric()) Then Goto Exit_Function + +Dim iArg As Integer, iWrong As Integer ' Check arguments values + iArg = 0 + If pvHeight < -1 Then + iArg = 4 : iWrong = pvHeight + ElseIf pvWidth < -1 Then + iArg = 3 : iWrong = pvWidth + ElseIf pvTop < -1 Then + iArg = 2 : iWrong = pvTop + ElseIf pvLeft < -1 Then + iArg = 1 : iWrong = pvLeft + End If + If iArg > 0 Then + TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, 1, Array(iArgNr + iArg, iWrong)) + Goto Exit_Function + End If + +Dim iPosSize As Integer + iPosSize = 0 + If pvLeft >= 0 Then iPosSize = iPosSize + com.sun.star.awt.PosSize.X + If pvTop >= 0 Then iPosSize = iPosSize + com.sun.star.awt.PosSize.Y + If pvWidth > 0 Then iPosSize = iPosSize + com.sun.star.awt.PosSize.WIDTH + If pvHeight > 0 Then iPosSize = iPosSize + com.sun.star.awt.PosSize.HEIGHT + If iPosSize > 0 Then UnoDialog.setPosSize(pvLeft, pvTop, pvWidth, pvHeight, iPosSize) + Move = True + +Exit_Function: + Utils._ResetCalledSub("Dialog.Move") + Exit Function +Error_Function: + TraceError(TRACEABORT, Err, "Dialog.Move", Erl) + GoTo Exit_Function +End Function ' Move + +REM ----------------------------------------------------------------------------------------------------------------------- +Public Function setProperty(ByVal Optional psProperty As String, ByVal Optional pvValue As Variant) As Boolean +' Return True if property setting OK + Utils._SetCalledSub("Dialog.setProperty") + setProperty = _PropertySet(psProperty, pvValue) + Utils._ResetCalledSub("Dialog.setProperty") +End Function + +REM ----------------------------------------------------------------------------------------------------------------------- +Public Function Start() As Boolean +' Create dialog + +If _ErrorHandler() Then On Local Error Goto Error_Function + Utils._SetCalledSub("Dialog.Start") + +Dim oStart As Object + Start = False + If IsNull(_Dialog) Then Goto Error_Start + If Not IsNull(UnoDialog) Then Goto Error_Yet_Started + Set oStart = CreateUnoDialog(_Dialog) + If IsNull(oStart) Then + Goto Error_Start + Else + Start = True + Set UnoDialog = oStart + With _A2B_ + If .hasItem(COLLALLDIALOGS, _Name) Then .Dialogs.Remove(_Name) ' Inserted to solve errors, when aborts between start and terminate + .Dialogs.Add(UnoDialog, UCase(_Name)) + End With + End If + +Exit_Function: + Utils._ResetCalledSub("Dialog.Start") + Exit Function +Error_Start: + TraceError(TRACEFATAL, ERRDIALOGUNDEFINED, Utils._CalledSub(), 0) + Goto Exit_Function +Error_Yet_Started: + TraceError(TRACEWARNING, ERRDIALOGSTARTED, Utils._CalledSub(), 0) + Goto Exit_Function +Error_Function: + TraceError(TRACEABORT, Err, "Dialog.Start", Erl) + GoTo Exit_Function +End Function ' Start + +REM ----------------------------------------------------------------------------------------------------------------------- +Public Function Terminate() As Boolean +' Close dialog + +If _ErrorHandler() Then On Local Error Goto Error_Function + Utils._SetCalledSub("Dialog.Terminate") + + Terminate = False + If IsNull(_Dialog) Then Goto Error_Terminate + If IsNull(UnoDialog) Then Goto Error_Not_Started + UnoDialog.Dispose() + Set UnoDialog = Nothing + _A2B_.Dialogs.Remove(_Name) + Terminate = True + +Exit_Function: + Utils._ResetCalledSub("Dialog.Terminate") + Exit Function +Error_Terminate: + TraceError(TRACEFATAL, ERRDIALOGUNDEFINED, Utils._CalledSub(), 0) + Goto Exit_Function +Error_Not_Started: + TraceError(TRACEWARNING, ERRDIALOGNOTSTARTED, Utils._CalledSub(), 0, 1, _Name) + Goto Exit_Function +Error_Function: + TraceError(TRACEABORT, Err, "Dialog.Terminate", Erl) + GoTo Exit_Function +End Function ' Terminate + +REM ----------------------------------------------------------------------------------------------------------------------- +REM --- PRIVATE FUNCTIONS --- +REM ----------------------------------------------------------------------------------------------------------------------- + +REM ----------------------------------------------------------------------------------------------------------------------- +Private Function _GetListener(ByVal psProperty As String) As String +' Return the X...Listener corresponding with the property in argument + + Select Case UCase(psProperty) + Case UCase("OnFocusGained"), UCase("OnFocusLost") + _GetListener = "XFocusListener" + Case UCase("OnKeyPressed"), UCase("OnKeyReleased") + _GetListener = "XKeyListener" + Case UCase("OnMouseDragged"), UCase("OnMouseMoved") + _GetListener = "XMouseMotionListener" + Case UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMousePressed"), UCase("OnMouseReleased") + _GetListener = "XMouseListener" + End Select + +End Function ' _GetListener V1.7.0 + +REM ----------------------------------------------------------------------------------------------------------------------- +Private Function _PropertiesList() As Variant + + If IsLoaded Then + _PropertiesList = Array("Caption", "Height", "IsLoaded", "Name" _ + , "OnFocusGained", "OnFocusLost", "OnKeyPressed", "OnKeyReleased", "OnMouseDragged" _ + , "OnMouseEntered", "OnMouseExited", "OnMouseMoved", "OnMousePressed", "OnMouseReleased" _ + , "ObjectType", "Page", "Visible", "Width" _ + ) + Else + _PropertiesList = Array("IsLoaded", "Name" _ + ) + End If + +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("Dialog.get" & psProperty) + +Dim oDialogEvents As Object, sEventName As String + +'Execute + _PropertyGet = EMPTY + + Select Case UCase(psProperty) + Case UCase("Name"), UCase("IsLoaded") + Case Else + If IsNull(UnoDialog) Then Goto Trace_Error_Dialog + End Select + Select Case UCase(psProperty) + Case UCase("Caption") + _PropertyGet = UnoDialog.getTitle() + Case UCase("Height") + _PropertyGet = UnoDialog.getPosSize().Height + Case UCase("IsLoaded") + _PropertyGet = _A2B_.hasItem(COLLALLDIALOGS, _Name) + Case UCase("Name") + _PropertyGet = _Name + Case UCase("ObjectType") + _PropertyGet = _Type + Case UCase("OnFocusGained"), UCase("OnFocusLost"), UCase("OnKeyPressed"), UCase("OnKeyReleased") _ + , UCase("OnMouseDragged"), UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMouseMoved") _ + , UCase("OnMousePressed"), UCase("OnMouseReleased") + Set oDialogEvents = unoDialog.Model.getEvents() + sEventName = "com.sun.star.awt." & _GetListener(psProperty) & "::" & Utils._GetEventName(psProperty) + If oDialogEvents.hasByName(sEventName) Then + _PropertyGet = oDialogEvents.getByName(sEventName).ScriptCode + Else + _PropertyGet = "" + End If + Case UCase("Page") + _PropertyGet = UnoDialog.Model.Step + Case UCase("Visible") + _PropertyGet = UnoDialog.IsVisible() + Case UCase("Width") + _PropertyGet = UnoDialog.getPosSize().Width + Case Else + Goto Trace_Error + End Select + +Exit_Function: + Utils._ResetCalledSub("Dialog.get" & psProperty) + Exit Function +Trace_Error: + TraceError(TRACEWARNING, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty) + _PropertyGet = EMPTY + Goto Exit_Function +Trace_Error_Dialog: + TraceError(TRACEFATAL, ERRDIALOGNOTSTARTED, Utils._CalledSub(), 0, 1, _Name) + _PropertyGet = EMPTY + Goto Exit_Function +Error_Function: + TraceError(TRACEABORT, Err, "Dialog._PropertyGet", Erl) + _PropertyGet = EMPTY + GoTo Exit_Function +End Function ' _PropertyGet + +REM ----------------------------------------------------------------------------------------------------------------------- +Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Variant) As Boolean + + Utils._SetCalledSub("Dialog.set" & psProperty) + If _ErrorHandler() Then On Local Error Goto Error_Function + _PropertySet = True + +Dim oDialogEvents As Object, sEventName As String, oEvent As Object, sListener As String, sEvent As String + +'Execute +Dim iArgNr As Integer + + If _IsLeft(_A2B_.CalledSub, "Dialog.") Then iArgNr = 1 Else iArgNr = 2 + If IsNull(UnoDialog) Then Goto Trace_Error_Dialog + Select Case UCase(psProperty) + Case UCase("Caption") + If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value + UnoDialog.setTitle(pvValue) + Case UCase("Height") + If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value + UnoDialog.setPosSize(0, 0, 0, pvValue, com.sun.star.awt.PosSize.HEIGHT) + Case UCase("OnFocusGained"), UCase("OnFocusLost"), UCase("OnKeyPressed"), UCase("OnKeyReleased") _ + , UCase("OnMouseDragged"), UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMouseMoved") _ + , UCase("OnMousePressed"), UCase("OnMouseReleased") + If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value + If Not Utils._RegisterDialogEventScript(UnoDialog.Model _ + , psProperty _ + , _GetListener(psProperty) _ + , pvValue _ + ) Then GoTo Trace_Error_Dialog + Case UCase("Page") + If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value + If pvValue < 0 Then Goto Trace_Error_Value + UnoDialog.Model.Step = pvValue + Case UCase("Visible") + If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value + UnoDialog.setVisible(pvValue) + Case UCase("Width") + If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric()) Then Goto Trace_Error_Value + UnoDialog.setPosSize(0, 0, pvValue, 0, com.sun.star.awt.PosSize.WIDTH) + Case Else + Goto Trace_Error + End Select + +Exit_Function: + Utils._ResetCalledSub("Dialog.set" & psProperty) + Exit Function +Trace_Error_Dialog: + TraceError(TRACEFATAL, ERRDIALOGNOTSTARTED, Utils._CalledSub(), 0, 1, _Name) + _PropertySet = False + Goto Exit_Function +Trace_Error: + TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, 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, "Dialog._PropertySet", Erl) + _PropertySet = False + GoTo Exit_Function +End Function ' _PropertySet + +</script:module>
\ No newline at end of file |