693 lines
29 KiB
Java
693 lines
29 KiB
Java
<?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="SF_Dialog" script:language="StarBasic" script:moduleType="normal">REM =======================================================================================================================
|
|
REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. ===
|
|
REM === The SFDialogs library is one of the associated libraries. ===
|
|
REM === Full documentation is available on https://help.libreoffice.org/ ===
|
|
REM =======================================================================================================================
|
|
|
|
Option Compatible
|
|
Option ClassModule
|
|
|
|
Option Explicit
|
|
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
''' SF_Dialog
|
|
''' =========
|
|
''' Management of dialogs defined with the Basic IDE
|
|
''' Each instance of the current class represents a single dialog box displayed to the user
|
|
'''
|
|
''' A dialog box can be displayed in modal or in non-modal modes
|
|
''' In modal mode, the box is displayed and the execution of the macro process is suspended
|
|
''' until one of the OK or Cancel buttons is pressed. In the meantime, other user actions
|
|
''' executed on the box can trigger specific actions.
|
|
''' In non-modal mode, the dialog box is "floating" on the user desktop and the execution
|
|
''' of the macro process continues normally
|
|
''' A dialog box disappears from memory after its explicit termination.
|
|
'''
|
|
''' Service invocation and usage:
|
|
''' Dim myDialog As Object, lButton As Long
|
|
''' Set myDialog = CreateScriptService("SFDialogs.Dialog", Container, Library, DialogName)
|
|
''' ' Args:
|
|
''' ' Container: "GlobalScope" for preinstalled libraries
|
|
''' ' A window name (see its definition in the ScriptForge.UI service)
|
|
''' ' "" (default) = the current document
|
|
''' ' Library: The (case-sensitive) name of a library contained in the container
|
|
''' ' Default = "Standard"
|
|
''' ' DialogName: a case-sensitive string designating the dialog where it is about
|
|
''' ' ... Initialize controls ...
|
|
''' lButton = myDialog.Execute() ' Default mode = Modal
|
|
''' If lButton = myDialog.OKBUTTON Then
|
|
''' ' ... Process controls and do what is needed
|
|
''' End If
|
|
''' myDialog.Terminate()
|
|
'''
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
|
|
REM ================================================================== EXCEPTIONS
|
|
|
|
Private Const DIALOGDEADERROR = "DIALOGDEADERROR"
|
|
|
|
REM ============================================================= PRIVATE MEMBERS
|
|
|
|
Private [Me] As Object
|
|
Private [_Parent] As Object
|
|
Private ObjectType As String ' Must be DIALOG
|
|
Private ServiceName As String
|
|
|
|
' Dialog location
|
|
Private _Container As String
|
|
Private _Library As String
|
|
Private _Name As String
|
|
Private _CacheIndex As Long ' Index in cache storage
|
|
|
|
' Dialog UNO references
|
|
Private _DialogProvider As Object ' com.sun.star.io.XInputStreamProvider
|
|
Private _DialogControl As Object ' com.sun.star.awt.XControl - stardiv.Toolkit.UnoDialogControl
|
|
Private _DialogModel As Object ' com.sun.star.awt.XControlModel - stardiv.Toolkit.UnoControlDialogModel
|
|
|
|
' Dialog attributes
|
|
Private _Displayed As Boolean ' True after Execute()
|
|
Private _Modal As Boolean ' Set by Execute()
|
|
|
|
REM ============================================================ MODULE CONSTANTS
|
|
|
|
Private Const OKBUTTON = 1
|
|
Private Const CANCELBUTTON = 0
|
|
|
|
REM ===================================================== CONSTRUCTOR/DESTRUCTOR
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Sub Class_Initialize()
|
|
Set [Me] = Nothing
|
|
Set [_Parent] = Nothing
|
|
ObjectType = "DIALOG"
|
|
ServiceName = "SFDialogs.Dialog"
|
|
_Container = ""
|
|
_Library = ""
|
|
_Name = ""
|
|
_CacheIndex = -1
|
|
Set _DialogProvider = Nothing
|
|
Set _DialogControl = Nothing
|
|
Set _DialogModel = Nothing
|
|
_Displayed = False
|
|
_Modal = True
|
|
End Sub ' SFDialogs.SF_Dialog Constructor
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Sub Class_Terminate()
|
|
Call Class_Initialize()
|
|
End Sub ' SFDialogs.SF_Dialog Destructor
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Dispose() As Variant
|
|
If _CacheIndex >= 0 Then Terminate()
|
|
Call Class_Terminate()
|
|
Set Dispose = Nothing
|
|
End Function ' SFDialogs.SF_Dialog Explicit Destructor
|
|
|
|
REM ================================================================== PROPERTIES
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Caption() As Variant
|
|
''' The Caption property refers to the title of the dialog
|
|
Caption = _PropertyGet("Caption")
|
|
End Property ' SFDialogs.SF_Dialog.Caption (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let Caption(Optional ByVal pvCaption As Variant)
|
|
''' Set the updatable property Caption
|
|
_PropertySet("Caption", pvCaption)
|
|
End Property ' SFDialogs.SF_Dialog.Caption (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Height() As Variant
|
|
''' The Height property refers to the height of the dialog box
|
|
Height = _PropertyGet("Height")
|
|
End Property ' SFDialogs.SF_Dialog.Height (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let Height(Optional ByVal pvHeight As Variant)
|
|
''' Set the updatable property Height
|
|
_PropertySet("Height", pvHeight)
|
|
End Property ' SFDialogs.SF_Dialog.Height (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Modal() As Boolean
|
|
''' The Modal property specifies if the dialog box has been executed in modal mode
|
|
Modal = _PropertyGet("Modal")
|
|
End Property ' SFDialogs.SF_Dialog.Modal (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Name() As String
|
|
''' Return the name of the actual dialog
|
|
Name = _PropertyGet("Name")
|
|
End Property ' SFDialogs.SF_Dialog.Name
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Page() As Variant
|
|
''' A dialog may have several pages that can be traversed by the user step by step. The Page property of the Dialog object defines which page of the dialog is active.
|
|
''' The Page property of a control defines the page of the dialog on which the control is visible.
|
|
''' For example, if a control has a page value of 1, it is only visible on page 1 of the dialog.
|
|
''' If the page value of the dialog is increased from 1 to 2, then all controls with a page value of 1 disappear and all controls with a page value of 2 become visible.
|
|
Page = _PropertyGet("Page")
|
|
End Property ' SFDialogs.SF_Dialog.Page (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let Page(Optional ByVal pvPage As Variant)
|
|
''' Set the updatable property Page
|
|
_PropertySet("Page", pvPage)
|
|
End Property ' SFDialogs.SF_Dialog.Page (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Visible() As Variant
|
|
''' The Visible property is False before the Execute() statement
|
|
Visible = _PropertyGet("Visible")
|
|
End Property ' SFDialogs.SF_Dialog.Visible (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let Visible(Optional ByVal pvVisible As Variant)
|
|
''' Set the updatable property Visible
|
|
_PropertySet("Visible", pvVisible)
|
|
End Property ' SFDialogs.SF_Dialog.Visible (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Width() As Variant
|
|
''' The Width property refers to the Width of the dialog box
|
|
Width = _PropertyGet("Width")
|
|
End Property ' SFDialogs.SF_Dialog.Width (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let Width(Optional ByVal pvWidth As Variant)
|
|
''' Set the updatable property Width
|
|
_PropertySet("Width", pvWidth)
|
|
End Property ' SFDialogs.SF_Dialog.Width (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get XDialogModel() As Object
|
|
''' The XDialogModel property returns the model UNO object of the dialog
|
|
XDialogModel = _PropertyGet("XDialogModel")
|
|
End Property ' SFDialogs.SF_Dialog.XDialogModel (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get XDialogView() As Object
|
|
''' The XDialogView property returns the view UNO object of the dialog
|
|
XDialogView = _PropertyGet("XDialogView")
|
|
End Property ' SFDialogs.SF_Dialog.XDialogView (get)
|
|
|
|
REM ===================================================================== METHODS
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Activate() As Boolean
|
|
''' Set the focus on the current dialog instance
|
|
''' Probably called from after an event occurrence or to focus on a non-modal dialog
|
|
''' Args:
|
|
''' Returns:
|
|
''' True if focusing is successful
|
|
''' Example:
|
|
''' Dim oDlg As Object
|
|
''' Set oDlg = CreateScriptService(,, "myDialog") ' Dialog stored in current document's standard library
|
|
''' oDlg.Activate()
|
|
|
|
Dim bActivate As Boolean ' Return value
|
|
Const cstThisSub = "SFDialogs.Dialog.Activate"
|
|
Const cstSubArgs = ""
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bActivate = False
|
|
|
|
Check:
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
End If
|
|
Try:
|
|
If Not IsNull(_DialogControl) Then
|
|
_DialogControl.setFocus()
|
|
bActivate = True
|
|
End If
|
|
|
|
Finally:
|
|
Activate = bActivate
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDialogs.SF_Dialog.Activate
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Controls(Optional ByVal ControlName As Variant) As Variant
|
|
''' Return either
|
|
''' - the list of the controls contained in the dialog
|
|
''' - a dialog control object based on its name
|
|
''' Args:
|
|
''' ControlName: a valid control name as a case-sensitive string. If absent the list is returned
|
|
''' Returns:
|
|
''' A zero-base array of strings if ControlName is absent
|
|
''' An instance of the SF_DialogControl class if ControlName exists
|
|
''' Exceptions:
|
|
''' ControlName is invalid
|
|
''' Example:
|
|
''' Dim myDialog As Object, myList As Variant, myControl As Object
|
|
''' Set myDialog = CreateScriptService("SFDialogs.Dialog", Container, Library, DialogName)
|
|
''' myList = myDialog.Controls()
|
|
''' Set myControl = myDialog.Controls("myTextBox")
|
|
|
|
Dim oControl As Object ' The new control class instance
|
|
Const cstThisSub = "SFDialogs.Dialog.Controls"
|
|
Const cstSubArgs = "[ControlName]"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
|
|
Check:
|
|
If IsMissing(ControlName) Or IsEmpty(ControlName) Then ControlName = ""
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(ControlName, "ControlName", V_STRING) Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
If Len(ControlName) = 0 Then
|
|
Controls = _DialogModel.getElementNames()
|
|
Else
|
|
If Not _DialogModel.hasByName(ControlName) Then GoTo CatchNotFound
|
|
' Create the new dialog control class instance
|
|
Set oControl = New SF_DialogControl
|
|
With oControl
|
|
._Name = ControlName
|
|
Set .[Me] = oControl
|
|
Set .[_Parent] = [Me]
|
|
._DialogName = _Name
|
|
Set ._ControlModel = _DialogModel.getByName(ControlName)
|
|
Set ._ControlView = _DialogControl.getControl(ControlName)
|
|
._Initialize()
|
|
End With
|
|
Set Controls = oControl
|
|
End If
|
|
|
|
Finally:
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
CatchNotFound:
|
|
ScriptForge.SF_Utils._Validate(ControlName, "ControlName", V_STRING, _DialogModel.getElementNames())
|
|
GoTo Finally
|
|
End Function ' SFDialogs.SF_Dialog.Controls
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Sub EndExecute(Optional ByVal ReturnValue As Variant)
|
|
''' Ends the display of a modal dialog and gives back the argument
|
|
''' as return value for the current Execute() action
|
|
''' EndExecute is usually contained in the processing of a macro
|
|
''' triggered by a dialog or control event
|
|
''' Args:
|
|
''' ReturnValue: must be numeric. The value passed to the running Execute() method
|
|
''' Example:
|
|
''' Sub OnEvent(poEvent As Variant)
|
|
''' Dim oDlg As Object
|
|
''' Set oDlg = CreateScriptService("SFDialogs.DialogEvent", poEvent)
|
|
''' oDlg.EndExecute(25)
|
|
''' End Sub
|
|
|
|
Dim lExecute As Long ' Alias of ReturnValue
|
|
Const cstThisSub = "SFDialogs.Dialog.EndExecute"
|
|
Const cstSubArgs = "ReturnValue"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
|
|
Check:
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(ReturnValue, "ReturnValue", V_NUMERIC) Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
lExecute = CLng(ReturnValue)
|
|
Call _DialogControl.endDialog(lExecute)
|
|
|
|
Finally:
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Sub
|
|
Catch:
|
|
GoTo Finally
|
|
End Sub ' SFDialogs.SF_Dialog.EndExecute
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Execute(Optional ByVal Modal As Variant) As Long
|
|
''' Display the dialog and wait for its termination by the user
|
|
''' Args:
|
|
''' Modal: False when non-modal dialog. Default = True
|
|
''' Returns:
|
|
''' 0 = Cancel button pressed
|
|
''' 1 = OK button pressed
|
|
''' Otherwise: the dialog stopped with an EndExecute statement executed from a dialog or control event
|
|
''' Example:
|
|
''' Dim oDlg As Object, lReturn As Long
|
|
''' Set oDlg = CreateScriptService(,, "myDialog") ' Dialog stored in current document's standard library
|
|
''' lReturn = oDlg.Execute()
|
|
''' Select Case lReturn
|
|
|
|
Dim lExecute As Long ' Return value
|
|
Const cstThisSub = "SFDialogs.Dialog.Execute"
|
|
Const cstSubArgs = "[Modal=True]"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
lExecute = -1
|
|
|
|
Check:
|
|
If IsMissing(Modal) Or IsEmpty(Modal) Then Modal = True
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Modal, "Modal", V_BOOLEAN) Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
If Modal Then
|
|
_Modal = True
|
|
_Displayed = True
|
|
lExecute = _DialogControl.execute()
|
|
Select Case lExecute
|
|
Case 1 : lExecute = OKBUTTON
|
|
Case 0 : lExecute = CANCELBUTTON
|
|
Case Else
|
|
End Select
|
|
_Displayed = False
|
|
Else
|
|
_Modal = False
|
|
_Displayed = True
|
|
_DialogModel.DesktopAsParent = True
|
|
_DialogControl.setVisible(True)
|
|
lExecute = 0
|
|
End If
|
|
|
|
Finally:
|
|
Execute = lExecute
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDialogs.SF_Dialog.Execute
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
|
|
''' Return the actual value of the given property
|
|
''' Args:
|
|
''' PropertyName: the name of the property as a string
|
|
''' Returns:
|
|
''' The actual value of the property
|
|
''' Exceptions:
|
|
''' ARGUMENTERROR The property does not exist
|
|
''' Examples:
|
|
''' oDlg.GetProperty("Caption")
|
|
|
|
Const cstThisSub = "Model.GetProperty"
|
|
Const cstSubArgs = ""
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
GetProperty = Null
|
|
|
|
Check:
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
|
|
End If
|
|
|
|
Try:
|
|
GetProperty = _PropertyGet(PropertyName)
|
|
|
|
Finally:
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDialogs.SF_Dialog.GetProperty
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Methods() As Variant
|
|
''' Return the list of public methods of the Model service as an array
|
|
|
|
Methods = Array( _
|
|
"Activate" _
|
|
, "Controls" _
|
|
, "EndExecute" _
|
|
, "Execute" _
|
|
, "Terminate" _
|
|
)
|
|
|
|
End Function ' SFDialogs.SF_Dialog.Methods
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Properties() As Variant
|
|
''' Return the list or properties of the Timer class as an array
|
|
|
|
Properties = Array( _
|
|
"Caption" _
|
|
, "Height" _
|
|
, "Modal" _
|
|
, "Name" _
|
|
, "Page" _
|
|
, "Visible" _
|
|
, "Width" _
|
|
)
|
|
|
|
End Function ' SFDialogs.SF_Dialog.Properties
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function SetProperty(Optional ByVal PropertyName As Variant _
|
|
, Optional ByRef Value As Variant _
|
|
) As Boolean
|
|
''' Set a new value to the given property
|
|
''' Args:
|
|
''' PropertyName: the name of the property as a string
|
|
''' Value: its new value
|
|
''' Exceptions
|
|
''' ARGUMENTERROR The property does not exist
|
|
|
|
Const cstThisSub = "SFDialogs.Dialog.SetProperty"
|
|
Const cstSubArgs = "PropertyName, Value"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
SetProperty = False
|
|
|
|
Check:
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
|
|
End If
|
|
|
|
Try:
|
|
SetProperty = _PropertySet(PropertyName, Value)
|
|
|
|
Finally:
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDialogs.SF_Dialog.SetProperty
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Terminate() As Boolean
|
|
''' Terminate the dialog service for the current dialog instance
|
|
''' After termination any action on the current instance will be ignored
|
|
''' Args:
|
|
''' Returns:
|
|
''' True if termination is successful
|
|
''' Example:
|
|
''' Dim oDlg As Object, lReturn As Long
|
|
''' Set oDlg = CreateScriptService(,, "myDialog") ' Dialog stored in current document's standard library
|
|
''' lreturn = oDlg.Execute()
|
|
''' Select Case lReturn
|
|
''' ' ...
|
|
''' End Select
|
|
''' oDlg.Terminate()
|
|
|
|
Dim bTerminate As Boolean ' Return value
|
|
Const cstThisSub = "SFDialogs.Dialog.Terminate"
|
|
Const cstSubArgs = ""
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bTerminate = False
|
|
|
|
Check:
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
End If
|
|
Try:
|
|
_DialogControl.dispose()
|
|
Set _DialogControl = Nothing
|
|
SF_Register._CleanCacheEntry(_CacheIndex)
|
|
_CacheIndex = -1
|
|
Dispose()
|
|
|
|
bTerminate = True
|
|
|
|
Finally:
|
|
Terminate = bTerminate
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDialogs.SF_Dialog.Terminate
|
|
|
|
REM =========================================================== PRIVATE FUNCTIONS
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Sub _Initialize()
|
|
''' Complete the object creation process:
|
|
''' - Initialization of private members
|
|
''' - Creation of the dialog graphical interface
|
|
''' - Addition of the new object in the Dialogs buffer
|
|
|
|
Try:
|
|
' Create the graphical interface
|
|
Set _DialogControl = CreateUnoDialog(_DialogProvider)
|
|
Set _DialogModel = _DialogControl.Model
|
|
|
|
' Add dialog reference to cache
|
|
_CacheIndex = SF_Register._AddDialogToCache(_DialogControl, [Me])
|
|
85
|
|
Finally:
|
|
Exit Sub
|
|
End Sub ' SFDialogs.SF_Dialog._Initialize
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _IsStillAlive(Optional ByVal pbError As Boolean) As Boolean
|
|
''' Return True if the dialog service is still active
|
|
''' If dead the actual instance is disposed. The execution is cancelled when pbError = True (default)
|
|
''' Args:
|
|
''' pbError: if True (default), raise a fatal error
|
|
|
|
Dim bAlive As Boolean ' Return value
|
|
Dim sDialog As String ' Alias of DialogName
|
|
|
|
Check:
|
|
On Local Error GoTo Catch ' Anticipate DisposedException errors or alike
|
|
If IsMissing(pbError) Then pbError = True
|
|
|
|
Try:
|
|
bAlive = ( Not IsNull(_DialogProvider) And Not IsNull(_DialogControl) )
|
|
If Not bAlive Then GoTo Catch
|
|
|
|
Finally:
|
|
_IsStillAlive = bAlive
|
|
Exit Function
|
|
Catch:
|
|
bAlive = False
|
|
On Error GoTo 0
|
|
sDialog = _Name
|
|
Dispose()
|
|
If pbError Then ScriptForge.SF_Exception.RaiseFatal(DIALOGDEADERROR, sDialog)
|
|
GoTo Finally
|
|
End Function ' SFDialogs.SF_Dialog._IsStillAlive
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _PropertyGet(Optional ByVal psProperty As String) As Variant
|
|
''' Return the value of the named property
|
|
''' Args:
|
|
''' psProperty: the name of the property
|
|
|
|
Static oSession As Object ' Alias of SF_Session
|
|
Dim cstThisSub As String
|
|
Const cstSubArgs = ""
|
|
|
|
cstThisSub = "SFDialogs.Dialog.get" & psProperty
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
|
|
ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
|
|
If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
|
|
Select Case psProperty
|
|
Case "Caption"
|
|
If oSession.HasUNOProperty(_DialogModel, "Title") Then _PropertyGet = _DialogModel.Title
|
|
Case "Height"
|
|
If oSession.HasUNOProperty(_DialogModel, "Height") Then _PropertyGet = _DialogModel.Height
|
|
Case "Modal"
|
|
_PropertyGet = _Modal
|
|
Case "Name"
|
|
_PropertyGet = _Name
|
|
Case "Page"
|
|
If oSession.HasUNOProperty(_DialogModel, "Step") Then _PropertyGet = _DialogModel.Step
|
|
Case "Visible"
|
|
If oSession.HasUnoMethod(_DialogControl, "isVisible") Then _PropertyGet = CBool(_DialogControl.isVisible())
|
|
Case "Width"
|
|
If oSession.HasUNOProperty(_DialogModel, "Width") Then _PropertyGet = _DialogModel.Width
|
|
Case "XDialogModel"
|
|
Set _PropertyGet = _DialogModel
|
|
Case "XDialogView"
|
|
Set _PropertyGet = _DialogControl
|
|
Case Else
|
|
_PropertyGet = Null
|
|
End Select
|
|
|
|
Finally:
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDialogs.SF_Dialog._PropertyGet
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _PropertySet(Optional ByVal psProperty As String _
|
|
, Optional ByVal pvValue As Variant _
|
|
) As Boolean
|
|
''' Set the new value of the named property
|
|
''' Args:
|
|
''' psProperty: the name of the property
|
|
''' pvValue: the new value of the given property
|
|
''' Returns:
|
|
''' True if successful
|
|
|
|
Dim bSet As Boolean ' Return value
|
|
Static oSession As Object ' Alias of SF_Session
|
|
Dim cstThisSub As String
|
|
Const cstSubArgs = "Value"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bSet = False
|
|
|
|
cstThisSub = "SFDialogs.Dialog.set" & psProperty
|
|
ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
|
|
If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
|
|
bSet = True
|
|
Select Case UCase(psProperty)
|
|
Case UCase("Caption")
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Caption", V_STRING) Then GoTo Finally
|
|
If oSession.HasUNOProperty(_DialogModel, "Title") Then _DialogModel.Title = pvValue
|
|
Case UCase("Height")
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Height", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
If oSession.HasUNOProperty(_DialogModel, "Height") Then _DialogModel.Height = pvValue
|
|
Case UCase("Page")
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Page", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
If oSession.HasUNOProperty(_DialogModel, "Step") Then _DialogModel.Step = CLng(pvValue)
|
|
Case UCase("Visible")
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Visible", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If oSession.HasUnoMethod(_DialogControl, "setVisible") Then _DialogControl.setVisible(pvValue)
|
|
Case UCase("Width")
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Width", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
If oSession.HasUNOProperty(_DialogModel, "Width") Then _DialogModel.Width = pvValue
|
|
Case Else
|
|
bSet = False
|
|
End Select
|
|
|
|
Finally:
|
|
_PropertySet = bSet
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDialogs.SF_Dialog._PropertySet
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _Repr() As String
|
|
''' Convert the Model instance to a readable string, typically for debugging purposes (DebugPrint ...)
|
|
''' Args:
|
|
''' Return:
|
|
''' "[DIALOG]: Container.Library.Name"
|
|
|
|
_Repr = "[DIALOG]: " & _Container & "." & _Library & "." & _Name
|
|
|
|
End Function ' SFDialogs.SF_Dialog._Repr
|
|
|
|
REM ============================================ END OF SFDIALOGS.SF_DIALOG
|
|
</script:module> |