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