[Libreoffice-commits] core.git: wizards/source
Jean-Pierre Ledure (via logerrit)
logerrit at kemper.freedesktop.org
Thu Nov 5 15:26:06 UTC 2020
wizards/source/sfdialogs/SF_Dialog.xba | 693 ++++++++++++++++
wizards/source/sfdialogs/SF_DialogControl.xba | 1099 ++++++++++++++++++++++++++
wizards/source/sfdialogs/SF_Register.xba | 327 +++++++
wizards/source/sfdialogs/__License.xba | 26
wizards/source/sfdialogs/dialog.xlb | 3
wizards/source/sfdialogs/script.xlb | 8
6 files changed, 2156 insertions(+)
New commits:
commit 9597440731cad723434df0867dbe97506201df29
Author: Jean-Pierre Ledure <jp at ledure.be>
AuthorDate: Thu Nov 5 16:22:30 2020 +0100
Commit: Jean-Pierre Ledure <jp at ledure.be>
CommitDate: Thu Nov 5 16:22:30 2020 +0100
ScriptForge - SFDialogs library
Additional "LibreOffice Macros & Dialogs" library
Change-Id: I0bce9d8a19025e4184e847941a3c79f4a210b1ae
diff --git a/wizards/source/sfdialogs/SF_Dialog.xba b/wizards/source/sfdialogs/SF_Dialog.xba
new file mode 100644
index 000000000000..63abb011aeea
--- /dev/null
+++ b/wizards/source/sfdialogs/SF_Dialog.xba
@@ -0,0 +1,693 @@
+<?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/DESCTRUCTOR
+
+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>
\ No newline at end of file
diff --git a/wizards/source/sfdialogs/SF_DialogControl.xba b/wizards/source/sfdialogs/SF_DialogControl.xba
new file mode 100644
index 000000000000..3d1494a5c36c
--- /dev/null
+++ b/wizards/source/sfdialogs/SF_DialogControl.xba
@@ -0,0 +1,1099 @@
+<?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_DialogControl" 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_DialogControl
+''' ================
+''' Manage the controls belonging to a dialog defined with the Basic IDE
+''' Each instance of the current class represents a single control within a dialog box
+'''
+''' The focus is clearly set on getting and setting the values displayed by the controls of the dialog box,
+''' not on their formatting. The latter is easily accessible via the XControlModel and XControlView
+''' UNO objects.
+''' Essentially a single property "Value" maps many alternative UNO properties depending each on
+''' the control type.
+'''
+''' Service invocation:
+''' Dim myDialog As Object, myControl As Object
+''' Set myDialog = CreateScriptService("SFDialogs.Dialog", "GlobalScope", myLibrary, DialogName)
+''' Set myControl = myDialog.Controls("myTextBox")
+''' myControl.Value = "Dialog started at " & Now()
+''' myDialog.Execute()
+''' ' ... process the controls actual values
+''' myDialog.Terminate()
+'''
+'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+
+REM ================================================================== EXCEPTIONS
+
+Private Const CONTROLTYPEERROR = "CONTROLTYPEERROR"
+Private Const TEXTFIELDERROR = "TEXTFIELDERROR"
+
+REM ============================================================= PRIVATE MEMBERS
+
+Private [Me] As Object
+Private [_Parent] As Object
+Private ObjectType As String ' Must be DIALOGCONTROL
+Private ServiceName As String
+
+' Control naming
+Private _Name As String
+Private _DialogName As String ' Parent dialog name
+
+' Control UNO references
+Private _ControlModel As Object ' com.sun.star.awt.XControlModel
+Private _ControlView As Object ' com.sun.star.awt.XControl - stardiv.Toolkit.UnoDialogControl
+
+' Control attributes
+Private _ImplementationName As String
+Private _ControlType As String ' One of the CTLxxx constants
+
+REM ============================================================ MODULE CONSTANTS
+
+Private Const CTLBUTTON = "Button"
+Private Const CTLCHECKBOX = "CheckBox"
+Private Const CTLCOMBOBOX = "ComboBox"
+Private Const CTLCURRENCYFIELD = "CurrencyField"
+Private Const CTLDATEFIELD = "DateField"
+Private Const CTLFILECONTROL = "FileControl"
+Private Const CTLFIXEDLINE = "FixedLine"
+Private Const CTLFIXEDTEXT = "FixedText"
+Private Const CTLFORMATTEDFIELD = "FormattedField"
+Private Const CTLGROUPBOX = "GroupBox"
+Private Const CTLIMAGECONTROL = "ImageControl"
+Private Const CTLLISTBOX = "ListBox"
+Private Const CTLNUMERICFIELD = "NumericField"
+Private Const CTLPATTERNFIELD = "PatternField"
+Private Const CTLPROGRESSBAR = "ProgressBar"
+Private Const CTLRADIOBUTTON = "RadioButton"
+Private Const CTLSCROLLBAR = "ScrollBar"
+Private Const CTLTEXTFIELD = "TextField"
+Private Const CTLTIMEFIELD = "TimeField"
+
+REM ===================================================== CONSTRUCTOR/DESCTRUCTOR
+
+REM -----------------------------------------------------------------------------
+Private Sub Class_Initialize()
+ Set [Me] = Nothing
+ Set [_Parent] = Nothing
+ ObjectType = "DIALOGCONTROL"
+ ServiceName = "SFDialogs.DialogControl"
+ _Name = ""
+ _DialogName = ""
+ Set _ControlModel = Nothing
+ Set _ControlView = Nothing
+ _ImplementationName = ""
+ _ControlType = ""
+End Sub ' SFDialogs.SF_DialogControl Constructor
+
+REM -----------------------------------------------------------------------------
+Private Sub Class_Terminate()
+ Call Class_Initialize()
+End Sub ' SFDialogs.SF_DialogControl Destructor
+
+REM -----------------------------------------------------------------------------
+Public Function Dispose() As Variant
+ Call Class_Terminate()
+ Set Dispose = Nothing
+End Function ' SFDialogs.SF_DialogControl Explicit Destructor
+
+REM ================================================================== PROPERTIES
+
+REM -----------------------------------------------------------------------------
+Property Get Cancel() As Variant
+''' The Cancel property specifies if a command button has or not the behaviour of a Cancel button.
+ Cancel = _PropertyGet("Cancel", False)
+End Property ' SFDialogs.SF_DialogControl.Cancel (get)
+
+REM -----------------------------------------------------------------------------
+Property Let Cancel(Optional ByVal pvCancel As Variant)
+''' Set the updatable property Cancel
+ _PropertySet("Cancel", pvCancel)
+End Property ' SFDialogs.SF_DialogControl.Cancel (let)
+
+REM -----------------------------------------------------------------------------
+Property Get Caption() As Variant
+''' The Caption property refers to the text associated with the control
+ Caption = _PropertyGet("Caption", "")
+End Property ' SFDialogs.SF_DialogControl.Caption (get)
+
+REM -----------------------------------------------------------------------------
+Property Let Caption(Optional ByVal pvCaption As Variant)
+''' Set the updatable property Caption
+ _PropertySet("Caption", pvCaption)
+End Property ' SFDialogs.SF_DialogControl.Caption (let)
+
+REM -----------------------------------------------------------------------------
+Property Get ControlType() As String
+''' Return the type of the actual control: "CheckBox", "TextField", "DateField", ...
+ ControlType = _PropertyGet("ControlType")
+End Property ' SFDialogs.SF_DialogControl.ControlType
+
+REM -----------------------------------------------------------------------------
+Property Get Default() As Variant
+''' The Default property specifies whether a command button is the default (OK) button.
+ Default = _PropertyGet("Default", False)
+End Property ' SFDialogs.SF_DialogControl.Default (get)
+
+REM -----------------------------------------------------------------------------
+Property Let Default(Optional ByVal pvDefault As Variant)
+''' Set the updatable property Default
+ _PropertySet("Default", pvDefault)
+End Property ' SFDialogs.SF_DialogControl.Default (let)
+
+REM -----------------------------------------------------------------------------
+Property Get Enabled() As Variant
+''' The Enabled property specifies if the control is accessible with the cursor.
+ Enabled = _PropertyGet("Enabled")
+End Property ' SFDialogs.SF_DialogControl.Enabled (get)
+
+REM -----------------------------------------------------------------------------
+Property Let Enabled(Optional ByVal pvEnabled As Variant)
+''' Set the updatable property Enabled
+ _PropertySet("Enabled", pvEnabled)
+End Property ' SFDialogs.SF_DialogControl.Enabled (let)
+
+REM -----------------------------------------------------------------------------
+Property Get Format() As Variant
+''' The Format property specifies the format in which to display dates and times.
+ Format = _PropertyGet("Format", "")
+End Property ' SFDialogs.SF_DialogControl.Format (get)
+
+REM -----------------------------------------------------------------------------
+Property Let Format(Optional ByVal pvFormat As Variant)
+''' Set the updatable property Format
+''' NB: Format is read-only for formatted field controls
+ _PropertySet("Format", pvFormat)
+End Property ' SFDialogs.SF_DialogControl.Format (let)
+
+REM -----------------------------------------------------------------------------
+Property Get ListCount() As Long
+''' The ListCount property specifies the number of rows in a list box or a combo box
+ ListCount = _PropertyGet("ListCount", 0)
+End Property ' SFDialogs.SF_DialogControl.ListCount (get)
+
+REM -----------------------------------------------------------------------------
+Property Get ListIndex() As Variant
+''' The ListIndex property specifies which item is selected in a list box or combo box.
+''' In case of multiple selection, the index of the first one is returned or only one is set
+ ListIndex = _PropertyGet("ListIndex", -1)
+End Property ' SFDialogs.SF_DialogControl.ListIndex (get)
+
+REM -----------------------------------------------------------------------------
+Property Let ListIndex(Optional ByVal pvListIndex As Variant)
+''' Set the updatable property ListIndex
+ _PropertySet("ListIndex", pvListIndex)
+End Property ' SFDialogs.SF_DialogControl.ListIndex (let)
+
+REM -----------------------------------------------------------------------------
+Property Get Locked() As Variant
+''' The Locked property specifies if a control is read-only
+ Locked = _PropertyGet("Locked", False)
+End Property ' SFDialogs.SF_DialogControl.Locked (get)
+
+REM -----------------------------------------------------------------------------
+Property Let Locked(Optional ByVal pvLocked As Variant)
+''' Set the updatable property Locked
+ _PropertySet("Locked", pvLocked)
+End Property ' SFDialogs.SF_DialogControl.Locked (let)
+
+REM -----------------------------------------------------------------------------
+Property Get MultiSelect() As Variant
+''' The MultiSelect property specifies whether a user can make multiple selections in a listbox
+ MultiSelect = _PropertyGet("MultiSelect", False)
+End Property ' SFDialogs.SF_DialogControl.MultiSelect (get)
+
+REM -----------------------------------------------------------------------------
+Property Let MultiSelect(Optional ByVal pvMultiSelect As Variant)
+''' Set the updatable property MultiSelect
+ _PropertySet("MultiSelect", pvMultiSelect)
+End Property ' SFDialogs.SF_DialogControl.MultiSelect (let)
+
+REM -----------------------------------------------------------------------------
+Property Get Name() As String
+''' Return the name of the actual control
+ Name = _PropertyGet("Name")
+End Property ' SFDialogs.SF_DialogControl.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_DialogControl.Page (get)
+
+REM -----------------------------------------------------------------------------
+Property Let Page(Optional ByVal pvPage As Variant)
+''' Set the updatable property Page
+ _PropertySet("Page", pvPage)
+End Property ' SFDialogs.SF_DialogControl.Page (let)
+
+REM -----------------------------------------------------------------------------
+Property Get Parent() As Object
+''' Return the Parent dialog object of the actual control
+ Parent = _PropertyGet("Parent", Nothing)
+End Property ' SFDialogs.SF_DialogControl.Parent
+
+REM -----------------------------------------------------------------------------
+Property Get Picture() As Variant
+''' The Picture property specifies a bitmap or other type of graphic to be displayed on the specified control
+ Picture = _PropertyGet("Picture", "")
+End Property ' SFDialogs.SF_DialogControl.Picture (get)
+
+REM -----------------------------------------------------------------------------
+Property Let Picture(Optional ByVal pvPicture As Variant)
+''' Set the updatable property Picture
+ _PropertySet("Picture", pvPicture)
+End Property ' SFDialogs.SF_DialogControl.Picture (let)
+
+REM -----------------------------------------------------------------------------
+Property Get RowSource() As Variant
+''' The RowSource property specifies the data contained in a combobox or a listbox
+''' as a zero-based array of string values
+ RowSource = _PropertyGet("RowSource", "")
+End Property ' SFDialogs.SF_DialogControl.RowSource (get)
+
+REM -----------------------------------------------------------------------------
+Property Let RowSource(Optional ByVal pvRowSource As Variant)
+''' Set the updatable property RowSource
+ _PropertySet("RowSource", pvRowSource)
+End Property ' SFDialogs.SF_DialogControl.RowSource (let)
+
+REM -----------------------------------------------------------------------------
+Property Get Text() As Variant
+''' The Text property specifies the actual content of the control like it is displayed on the screen
+ Text = _PropertyGet("Text", "")
+End Property ' SFDialogs.SF_DialogControl.Text (get)
+
+REM -----------------------------------------------------------------------------
+Property Get TipText() As Variant
+''' The TipText property specifies the text that appears in a screentip when you hold the mouse pointer over a control
+ TipText = _PropertyGet("TipText", "")
+End Property ' SFDialogs.SF_DialogControl.TipText (get)
+
+REM -----------------------------------------------------------------------------
+Property Let TipText(Optional ByVal pvTipText As Variant)
+''' Set the updatable property TipText
+ _PropertySet("TipText", pvTipText)
+End Property ' SFDialogs.SF_DialogControl.TipText (let)
+
+REM -----------------------------------------------------------------------------
+Property Get TripleState() As Variant
+''' The TripleState property specifies how a check box will display Null values
+''' When True, the control will cycle through states for Yes, No, and Null values. The control appears dimmed (grayed) when its Value property is set to Null.
+''' When False, the control will cycle through states for Yes and No values. Null values display as if they were No values.
+ TripleState = _PropertyGet("TripleState", False)
+End Property ' SFDialogs.SF_DialogControl.TripleState (get)
+
+REM -----------------------------------------------------------------------------
+Property Let TripleState(Optional ByVal pvTripleState As Variant)
+''' Set the updatable property TripleState
+ _PropertySet("TripleState", pvTripleState)
+End Property ' SFDialogs.SF_DialogControl.TripleState (let)
+
+REM -----------------------------------------------------------------------------
+Property Get Value() As Variant
+''' The Value property specifies the data contained in the control
+ Value = _PropertyGet("Value", Empty)
+End Property ' SFDialogs.SF_DialogControl.Value (get)
+
+REM -----------------------------------------------------------------------------
+Property Let Value(Optional ByVal pvValue As Variant)
+''' Set the updatable property Value
+ _PropertySet("Value", pvValue)
+End Property ' SFDialogs.SF_DialogControl.Value (let)
+
+REM -----------------------------------------------------------------------------
+Property Get Visible() As Variant
+''' The Visible property specifies if the control is accessible with the cursor.
+ Visible = _PropertyGet("Visible", True)
+End Property ' SFDialogs.SF_DialogControl.Visible (get)
+
+REM -----------------------------------------------------------------------------
+Property Let Visible(Optional ByVal pvVisible As Variant)
+''' Set the updatable property Visible
+ _PropertySet("Visible", pvVisible)
+End Property ' SFDialogs.SF_DialogControl.Visible (let)
+
+REM -----------------------------------------------------------------------------
+Property Get XControlModel() As Object
+''' The XControlModel property returns the model UNO object of the control
+ XControlModel = _PropertyGet("XControlModel", Nothing)
+End Property ' SFDialogs.SF_DialogControl.XControlModel (get)
+
+REM -----------------------------------------------------------------------------
+Property Get XControlView() As Object
+''' The XControlView property returns the view UNO object of the control
+ XControlView = _PropertyGet("XControlView", Nothing)
+End Property ' SFDialogs.SF_DialogControl.XControlView (get)
+
+REM ===================================================================== METHODS
+
+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
+''' If the property does not exist, returns Null
+''' Exceptions:
+''' see the exceptions of the individual properties
+''' Examples:
+''' myModel.GetProperty("MyProperty")
+
+Const cstThisSub = "SFDialogs.DialogControl.GetProperty"
+Const cstSubArgs = ""
+
+ If ScriptForge.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:
+ ScriptForge.SF_Utils._ExitFunction(cstThisSub)
+ Exit Function
+Catch:
+ GoTo Finally
+End Function ' SFDialogs.SF_DialogControl.GetProperty
+
+REM -----------------------------------------------------------------------------
+Public Function Methods() As Variant
+''' Return the list of public methods of the Model service as an array
+
+ Methods = Array( _
+ "SetFocus" _
+ , "WriteLine" _
+ )
+
+End Function ' SFDialogs.SF_DialogControl.Methods
+
+REM -----------------------------------------------------------------------------
+Public Function Properties() As Variant
+''' Return the list or properties of the Timer class as an array
+
+ Properties = Array( _
+ "Cancel" _
+ , "Caption" _
+ , "ControlType" _
+ , "Default" _
+ , "Enabled" _
+ , "Format" _
+ , "ListCount" _
+ , "ListIndex" _
+ , "Locked" _
+ , "MultiSelect" _
+ , "Name" _
+ , "Page" _
+ , "Parent" _
+ , "Picture" _
+ , "RowSource" _
+ , "Text" _
+ , "TipText" _
+ , "TripleState" _
+ , "Value" _
+ , "Visible" _
+ , "XControlModel" _
+ , "XControlView" _
+ )
+
+End Function ' SFDialogs.SF_DialogControl.Properties
+
+REM -----------------------------------------------------------------------------
+Public Function SetFocus() As Boolean
+''' Set the focus on the current Control instance
+''' Probably called from after an event occurrence
+''' Args:
+''' Returns:
+''' True if focusing is successful
+''' Example:
+''' Dim oDlg As Object, oControl As Object
+''' Set oDlg = CreateScriptService(,, "myControl") ' Control stored in current document's standard library
+''' Set oControl = oDlg.Controls("thisControl")
+''' oControl.SetFocus()
+
+Dim bSetFocus As Boolean ' Return value
+Const cstThisSub = "SFDialogs.DialogControl.SetFocus"
+Const cstSubArgs = ""
+
+ If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
+ bSetFocus = False
+
+Check:
+ If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
+ If Not [_Parent]._IsStillAlive() Then GoTo Finally
+ End If
+
+Try:
+ If Not IsNull(_ControlView) Then
+ _ControlView.setFocus()
+ bSetFocus = True
+ End If
+
+Finally:
+ SetFocus = bSetFocus
+ ScriptForge.SF_Utils._ExitFunction(cstThisSub)
+ Exit Function
+Catch:
+ GoTo Finally
+End Function ' SFControls.SF_DialogControl.SetFocus
+
+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.DialogControl.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_DialogControl.SetProperty
+
+REM -----------------------------------------------------------------------------
+Public Function WriteLine(Optional ByVal Line As Variant) As Boolean
+''' Add a new line to a multiline TextField control
+''' Args:
+''' Line: (default = "") the line to insert at the end of the text box
+''' a newline character will be inserted before the line, if relevant
+''' Returns:
+''' True if insertion is successful
+''' Exceptions
+''' TEXTFIELDERROR Method applicable on multiline text fields only
+''' Example:
+''' Dim oDlg As Object, oControl As Object
+''' Set oDlg = CreateScriptService(,, "myControl") ' Control stored in current document's standard library
+''' Set oControl = oDlg.Controls("thisControl")
+''' oControl.WriteLine("a new line")
+
+Dim bWriteLine As Boolean ' Return value
+Dim lTextLength As Long ' Actual length of text in box
+Dim oSelection As New com.sun.star.awt.Selection
+Dim sNewLine As String ' Newline character(s)
+Const cstThisSub = "SFDialogs.DialogControl.WriteLine"
+Const cstSubArgs = "[Line=""""]"
+
+ If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
+ bWriteLine = False
+
+Check:
+ If IsMissing(Line) Or IsEmpty(Line) Then Line = ""
+ If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
+ If Not [_Parent]._IsStillAlive() Then GoTo Finally
+ If Not ScriptForge.SF_Utils._Validate(Line, "Line", V_STRING) Then GoTo Finally
+ End If
+ If ControlType <> CTLTEXTFIELD Then GoTo CatchField
+ If _ControlModel.MultiLine = False Then GoTo CatchField
+
+Try:
+ _ControlModel.HardLineBreaks = True
+ sNewLine = ScriptForge.SF_String.sfNEWLINE
+ With _ControlView
+ lTextLength = Len(.getText())
+ If lTextLength = 0 Then ' Text field is still empty
+ oSelection.Min = 0 : oSelection.Max = 0
+ .setText(Line)
+ Else ' Put cursor at the end of the actual text
+ oSelection.Min = lTextLength : oSelection.Max = lTextLength
+ .insertText(oSelection, sNewLine & Line)
+ End If
+ ' Put the cursor at the end of the inserted text
+ oSelection.Max = oSelection.Max + Len(sNewLine) + Len(Line)
+ oSelection.Min = oSelection.Max
+ .setSelection(oSelection)
+ End With
+ bWriteLine = True
+
+Finally:
+ WriteLine = bWriteLine
+ ScriptForge.SF_Utils._ExitFunction(cstThisSub)
+ Exit Function
+Catch:
+ GoTo Finally
+CatchField:
+ ScriptForge.SF_Exception.RaiseFatal(TEXTFIELDERROR, _Name, _DialogName)
+ GoTo Finally
+End Function ' SFControls.SF_DialogControl.WriteLine
+
+REM =========================================================== PRIVATE FUNCTIONS
+
+REM -----------------------------------------------------------------------------
+Private Function _FormatsList() As Variant
+''' Return the allowed format entries as a zero-based array for Date and Time control types
+
+Dim vFormats() As Variant ' Return value
+
+ Select Case _ControlType
+ Case CTLDATEFIELD
+ vFormats = Array( _
+ "Standard (short)" _
+ , "Standard (short YY)" _
+ , "Standard (short YYYY)" _
+ , "Standard (long)" _
+ , "DD/MM/YY" _
+ , "MM/DD/YY" _
+ , "YY/MM/DD" _
+ , "DD/MM/YYYY" _
+ , "MM/DD/YYYY" _
+ , "YYYY/MM/DD" _
+ , "YY-MM-DD" _
+ , "YYYY-MM-DD" _
+ )
+ Case CTLTIMEFIELD
+ vFormats = Array( _
+ "24h short" _
+ , "24h long" _
+ , "12h short" _
+ , "12h long" _
+ )
+ Case Else
+ vFormats = Array()
+ End Select
+
+ _FormatsList = vFormats
+
+End Function ' SFDialogs.SF_DialogControl._FormatsList
+
+REM -----------------------------------------------------------------------------
+Public Sub _Initialize()
+''' Complete the object creation process:
+''' - Initialization of private members
+''' - Collection of main attributes
+
+Dim vServiceName As Variant ' Splitted service name
+Dim sType As String ' Last component of service name
+Try:
+ _ImplementationName = _ControlModel.getImplementationName()
+
+ ' Identify the control type
+ vServiceName = Split(_ControlModel.getServiceName(), ".")
+ sType = vServiceName(UBound(vServiceName))
+ Select Case sType
+ Case "UnoControlSpinButtonModel", "TreeControlModel"
+ _ControlType = "" ' Not supported
+ Case "Edit" : _ControlType = CTLTEXTFIELD
+ Case Else : _ControlType = sType
+ End Select
+
+Finally:
+ Exit Sub
+End Sub ' SFDialogs.SF_DialogControl._Initialize
+
+REM -----------------------------------------------------------------------------
+Private Function _PropertyGet(Optional ByVal psProperty As String _
+ , Optional ByVal pvDefault As Variant _
+ ) As Variant
+''' Return the value of the named property
+''' Args:
+''' psProperty: the name of the property
+''' pvDefault: the value returned when the property is not applicable on the control's type
+''' Getting a non-existing property for a specific control type should
+''' not generate an error to not disrupt the Basic IDE debugger
+
+Dim vGet As Variant ' Return value
+Static oSession As Object ' Alias of SF_Session
+Dim vSelection As Variant ' Alias of Model.SelectedItems
+Dim vList As Variant ' Alias of Model.StringItemList
+Dim lIndex As Long ' Index in StringItemList
+Dim sItem As String ' A single item
+Dim vDate As Variant ' com.sun.star.util.Date or com.sun.star.util.Time
+Dim vValues As Variant ' Array of listbox values
+Dim i As Long
+Dim cstThisSub As String
+Const cstSubArgs = ""
+
+ cstThisSub = "SFDialogs.DialogControl.get" & psProperty
+ If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
+
+ ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
+ If Not [_Parent]._IsStillAlive() Then GoTo Finally
+
+ If IsMissing(pvDefault) Then pvDefault = Null
+ _PropertyGet = pvDefault
+
+ If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
+ Select Case psProperty
+ Case "Cancel"
+ Select Case _ControlType
+ Case CTLBUTTON
+ If oSession.HasUNOProperty(_ControlModel, "PushButtonType") Then _PropertyGet = ( _ControlModel.PushButtonType = com.sun.star.awt.PushButtonType.CANCEL )
+ Case Else : GoTo CatchType
+ End Select
+ Case "Caption"
+ Select Case _ControlType
+ Case CTLBUTTON, CTLCHECKBOX, CTLFIXEDLINE, CTLFIXEDTEXT, CTLGROUPBOX, CTLRADIOBUTTON
+ If oSession.HasUNOProperty(_ControlModel, "Label") Then _PropertyGet = _ControlModel.Label
+ Case Else : GoTo CatchType
+ End Select
+ Case "ControlType"
+ _PropertyGet = _ControlType
+ Case "Default"
+ Select Case _ControlType
+ Case CTLBUTTON
+ If oSession.HasUNOProperty(_ControlModel, "DefaultButton") Then _PropertyGet = _ControlModel.DefaultButton
+ Case Else : GoTo CatchType
+ End Select
+ Case "Enabled"
+ If oSession.HasUnoProperty(_ControlModel, "Enabled") Then _PropertyGet = _ControlModel.Enabled
+ Case "Format"
+ Select Case _ControlType
+ Case CTLDATEFIELD
+ If oSession.HasUNOProperty(_ControlModel, "DateFormat") Then _PropertyGet = _FormatsList()(_ControlModel.DateFormat)
+ Case CTLTIMEFIELD
+ If oSession.HasUNOProperty(_ControlModel, "TimeFormat") Then _PropertyGet = _FormatsList()(_ControlModel.TimeFormat)
+ Case CTLFORMATTEDFIELD
+ If oSession.HasUNOProperty(_ControlModel, "FormatsSupplier") And oSession.HasUNOProperty(_ControlModel, "FormatKey") Then
+ _PropertyGet = _ControlModel.FormatsSupplier.getNumberFormats.getByKey(_ControlModel.FormatKey).FormatString
+ End If
+ Case Else : GoTo CatchType
+ End Select
+ Case "ListCount"
+ Select Case _ControlType
+ Case CTLCOMBOBOX, CTLLISTBOX
+ If oSession.HasUNOProperty(_ControlModel, "StringItemList") Then _PropertyGet = UBound(_ControlModel.StringItemList) + 1
+ Case Else : GoTo CatchType
+ End Select
+ Case "ListIndex"
+ Select Case _ControlType
+ Case CTLCOMBOBOX
+ _PropertyGet = -1 ' Not found, multiselection
+ If oSession.HasUNOProperty(_ControlModel, "Text") And oSession.HasUNOProperty(_ControlModel, "StringItemList") Then
+ _PropertyGet = ScriptForge.SF_Array.IndexOf(_ControlModel.StringItemList, _ControlModel.Text, CaseSensitive := True)
+ End If
+ Case CTLLISTBOX
+ _PropertyGet = -1 ' Not found, multiselection
+ If oSession.HasUNOProperty(_ControlModel, "SelectedItems") And oSession.HasUNOProperty(_ControlModel, "StringItemList") Then
+ vSelection = _ControlModel.SelectedItems
+ If UBound(vSelection) >= 0 Then _PropertyGet = vSelection(0)
+ End If
+ Case Else : GoTo CatchType
+ End Select
+ Case "Locked"
+ Select Case _ControlType
+ Case CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLFILECONTROL, CTLFORMATTEDFIELD, CTLLISTBOX _
+ , CTLNUMERICFIELD, CTLPATTERNFIELD, CTLTEXTFIELD, CTLTIMEFIELD
+ If oSession.HasUnoProperty(_ControlModel, "ReadOnly") Then _PropertyGet = _ControlModel.ReadOnly
+ Case Else : GoTo CatchType
+ End Select
+ Case "MultiSelect"
+ Select Case _ControlType
+ Case CTLLISTBOX
+ If oSession.HasUnoProperty(_ControlModel, "MultiSelection") Then
+ _PropertyGet = _ControlModel.MultiSelection
+ ElseIf oSession.HasUnoProperty(_ControlModel, "MultiSelectionSimpleMode") Then ' Not documented: gridcontrols only TBC ??
+ _PropertyGet = _ControlModel.MultiSelectionSimpleMode
+ End If
+ Case Else : GoTo CatchType
+ End Select
+ Case "Name"
+ _PropertyGet = _Name
+ Case "Page"
+ If oSession.HasUnoProperty(_ControlModel, "Step") Then _PropertyGet = _ControlModel.Step
+ Case "Parent"
+ Set _PropertyGet = [_Parent]
+ Case "Picture"
+ Select Case _ControlType
+ Case CTLBUTTON, CTLIMAGECONTROL
+ If oSession.HasUnoProperty(_ControlModel, "ImageURL") Then _PropertyGet = ScriptForge.SF_FileSystem._ConvertFromUrl(_ControlModel.ImageURL)
+ Case Else : GoTo CatchType
+ End Select
+ Case "RowSource"
+ Select Case _ControlType
+ Case CTLCOMBOBOX, CTLLISTBOX
+ If oSession.HasUnoProperty(_ControlModel, "StringItemList") Then
+ If IsArray(_ControlModel.StringItemList) Then _PropertyGet = _ControlModel.StringItemList Else _PropertyGet = Array(_ControlModel.StringItemList)
+ End If
+ Case Else : GoTo CatchType
+ End Select
+ Case "Text"
+ Select Case _ControlType
+ Case CTLCOMBOBOX, CTLFILECONTROL, CTLFORMATTEDFIELD, CTLPATTERNFIELD, CTLTEXTFIELD
+ If oSession.HasUnoProperty(_ControlModel, "Text") Then _PropertyGet = _ControlModel.Text
+ Case Else : GoTo CatchType
+ End Select
+ Case "TipText"
+ If oSession.HasUnoProperty(_ControlModel, "HelpText") Then _PropertyGet = _ControlModel.HelpText
+ Case "TripleState"
+ Select Case _ControlType
+ Case CTLCHECKBOX
+ If oSession.HasUnoProperty(_ControlModel, "TriState") Then _PropertyGet = _ControlModel.TriState
+ Case Else : GoTo CatchType
+ End Select
+ Case "Value" ' Default values are set here by control type, not in the 2nd argument
+ vGet = pvDefault
+ Select Case _ControlType
+ Case CTLBUTTON 'Boolean, toggle buttons only
+ vGet = False
+ If oSession.HasUnoProperty(_ControlModel, "Toggle") Then
+ If oSession.HasUnoProperty(_ControlModel, "State") Then vGet = ( _ControlModel.State = 1 )
+ End If
+ Case CTLCHECKBOX '0 = Not checked, 1 = Checked, 2 = Don't know
+ If oSession.HasUnoProperty(_ControlModel, "State") Then vGet = _ControlModel.State Else vGet = 2
+ Case CTLCOMBOBOX, CTLFILECONTROL, CTLPATTERNFIELD, CTLTEXTFIELD 'String
+ If oSession.HasUnoProperty(_ControlModel, "Text") Then vGet = _ControlModel.Text Else vGet = ""
+ Case CTLCURRENCYFIELD, CTLNUMERICFIELD 'Numeric
+ If oSession.HasUnoProperty(_ControlModel, "Value") Then vGet = _ControlModel.Value Else vGet = 0
+ Case CTLDATEFIELD 'Date
+ vGet = CDate(1)
+ If oSession.HasUnoProperty(_ControlModel, "Date") Then
+ If VarType(_ControlModel.Date) = ScriptForge.V_OBJECT Then ' com.sun.star.util.Date
+ Set vDate = _ControlModel.Date
+ vGet = DateSerial(vDate.Year, vDate.Month, vDate.Day)
+ End If
+ End If
+ Case CTLFORMATTEDFIELD 'String or numeric
+ If oSession.HasUnoProperty(_ControlModel, "EffectiveValue") Then vGet = _ControlModel.EffectiveValue Else vGet = ""
+ Case CTLLISTBOX 'String or array of strings depending on MultiSelection
+ ' StringItemList is the list of the items displayed in the box
+ ' SelectedItems is the list of the indexes in StringItemList of the selected items
+ ' It can go beyond the limits of StringItemList
+ ' It can contain multiple values even if the listbox is not multiselect
+ If oSession.HasUnoProperty(_ControlModel, "StringItemList") And oSession.HasUnoProperty(_ControlModel, "SelectedItems") _
+ And oSession.HasUnoProperty(_ControlModel, "MultiSelection") Then
+ vSelection = _ControlModel.SelectedItems
+ vList = _ControlModel.StringItemList
+ If _ControlModel.MultiSelection Then vValues = Array()
+ For i = 0 To UBound(vSelection)
+ lIndex = vSelection(i)
+ If lIndex >= 0 And lIndex <= UBound(vList) Then
+ If Not _ControlModel.MultiSelection Then
+ vValues = vList(lIndex)
+ Exit For
+ End If
+ vValues = ScriptForge.SF_Array.Append(vValues, vList(lIndex))
+ End If
+ Next i
+ vGet = vValues
+ Else
+ vGet = ""
+ End If
+ Case CTLPROGRESSBAR 'Numeric
+ If oSession.HasUnoProperty(_ControlModel, "ProgressValue") Then vGet = _ControlModel.ProgressValue Else vGet = 0
+ Case CTLRADIOBUTTON 'Boolean
+ If oSession.HasUnoProperty(_ControlModel, "State") Then vGet = ( _ControlModel.State = 1 ) Else vGet = False
+ Case CTLSCROLLBAR 'Numeric
+ If oSession.HasUnoProperty(_ControlModel, "ScrollValue") Then vGet = _ControlModel.ScrollValue Else vGet = 0
+ Case CTLTIMEFIELD
+ vGet = CDate(0)
+ If oSession.HasUnoProperty(_ControlModel, "Time") Then
+ If VarType(_ControlModel.Time) = ScriptForge.V_OBJECT Then ' com.sun.star.Util.Time
+ Set vDate = _ControlModel.Time
+ vGet = TimeSerial(vDate.Hours, vDate.Minutes, vDate.Seconds)
+ End If
+ End If
+ Case Else : GoTo CatchType
+ End Select
+ _PropertyGet = vGet
+ Case "Visible"
+ If oSession.HasUnoMethod(_ControlView, "isVisible") Then _PropertyGet = CBool(_ControlView.isVisible())
+ Case "XControlModel"
+ Set _PropertyGet = _ControlModel
+ Case "XControlView"
+ Set _PropertyGet = _ControlView
+ Case Else
+ _PropertyGet = Null
+ End Select
+
+Finally:
+ ScriptForge.SF_Utils._ExitFunction(cstThisSub)
+ Exit Function
+Catch:
+ GoTo Finally
+CatchType:
+ GoTo Finally
+End Function ' SFDialogs.SF_DialogControl._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
+
+Dim bSet As Boolean ' Return value
+Static oSession As Object ' Alias of SF_Session
+Dim vSet As Variant ' Value to set in UNO model or view property
+Dim vFormats As Variant ' Format property: output of _FormatsList()
+Dim iFormat As Integer ' Format property: index in vFormats
+Dim vSelection As Variant ' Alias of Model.SelectedItems
+Dim vList As Variant ' Alias of Model.StringItemList
+Dim lIndex As Long ' Index in StringItemList
+Dim sItem As String ' A single item
+Dim i As Long
+Dim cstThisSub As String
+Const cstSubArgs = "Value"
+
+ If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
+ bSet = False
+
+ cstThisSub = "SFDialogs.DialogControl.set" & psProperty
+ ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
+ If Not [_Parent]._IsStillAlive() Then GoTo Finally
+
+ If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
+ bSet = True
+ Select Case UCase(psProperty)
+ Case UCase("Cancel")
+ Select Case _ControlType
+ Case CTLBUTTON
+ If Not ScriptForge.SF_Utils._Validate(pvValue, "Cancel", ScriptForge.V_BOOLEAN) Then GoTo Finally
+ If oSession.HasUNOProperty(_ControlModel, "PushButtonType") Then
+ If pvValue Then vSet = com.sun.star.awt.PushButtonType.CANCEL Else vSet = com.sun.star.awt.PushButtonType.STANDARD
+ _ControlModel.PushButtonType = vSet
+ End If
+ Case Else : GoTo CatchType
+ End Select
+ Case UCase("Caption")
+ Select Case _ControlType
+ Case CTLBUTTON, CTLCHECKBOX, CTLFIXEDLINE, CTLFIXEDTEXT, CTLGROUPBOX, CTLRADIOBUTTON
+ If Not ScriptForge.SF_Utils._Validate(pvValue, "Caption", V_STRING) Then GoTo Finally
+ If oSession.HasUNOProperty(_ControlModel, "Label") Then _ControlModel.Label = pvValue
+ Case Else : GoTo CatchType
+ End Select
+ Case UCase("Default")
+ Select Case _ControlType
+ Case CTLBUTTON
+ If Not ScriptForge.SF_Utils._Validate(pvValue, "Default", ScriptForge.V_BOOLEAN) Then GoTo Finally
+ If oSession.HasUNOProperty(_ControlModel, "DefaultButton") Then _ControlModel.DefaultButton = pvValue
+ Case Else : GoTo CatchType
+ End Select
+ Case UCase("Enabled")
+ If Not ScriptForge.SF_Utils._Validate(pvValue, "Enabled", ScriptForge.V_BOOLEAN) Then GoTo Finally
+ If oSession.HasUnoProperty(_ControlModel, "Enabled") Then _ControlModel.Enabled = pvValue
+ Case UCase("Format")
+ Select Case _ControlType
+ Case CTLDATEFIELD, CTLTIMEFIELD
+ vFormats = _FormatsList()
+ If Not ScriptForge.SF_Utils._Validate(pvValue, "Format", V_STRING, vFormats) Then GoTo Finally
+ iFormat = ScriptForge.SF_Array.IndexOf(vFormats, pvValue, CaseSensitive := False)
+ If oSession.HasUNOProperty(_ControlModel, "DateFormat") Then
+ _ControlModel.DateFormat = iFormat
+ ElseIf oSession.HasUNOProperty(_ControlModel, "TimeFormat") Then
+ _ControlModel.TimeFormat = iFormat
+ End If
+ Case Else : GoTo CatchType
+ End Select
+ Case UCase("ListIndex")
+ If Not ScriptForge.SF_Utils._Validate(pvValue, "ListIndex", ScriptForge.V_NUMERIC) Then GoTo Finally
+ Select Case _ControlType
+ Case CTLCOMBOBOX
+ If oSession.HasUNOProperty(_ControlModel, "Text") And oSession.HasUNOProperty(_ControlModel, "StringItemList") Then
+ _ControlModel.Text = _ControlModel.StringItemList(CInt(pvValue))
+ End If
+ Case CTLLISTBOX
+ If oSession.HasUNOProperty(_ControlModel, "SelectedItems") Then _ControlModel.SelectedItems = Array(CInt(pvValue))
+ Case Else : GoTo CatchType
+ End Select
+ Case UCase("Locked")
+ Select Case _ControlType
+ Case CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLFILECONTROL, CTLFORMATTEDFIELD, CTLLISTBOX _
+ , CTLNUMERICFIELD, CTLPATTERNFIELD, CTLTEXTFIELD, CTLTIMEFIELD
+ If Not ScriptForge.SF_Utils._Validate(pvValue, "Locked", ScriptForge.V_BOOLEAN) Then GoTo Finally
+ If oSession.HasUnoProperty(_ControlModel, "ReadOnly") Then _ControlModel.ReadOnly = pvValue
+ Case Else : GoTo CatchType
+ End Select
+ Case UCase("MultiSelect")
+ Select Case _ControlType
+ Case CTLLISTBOX
+ If Not ScriptForge.SF_Utils._Validate(pvValue, "MultiSelect", ScriptForge.V_BOOLEAN) Then GoTo Finally
+ If oSession.HasUnoProperty(_ControlModel, "MultiSelection") Then _ControlModel.MultiSelection = pvValue
+ If oSession.HasUnoProperty(_ControlModel, "MultiSelectionSimpleMode") Then _ControlModel.MultiSelectionSimpleMode = pvValue
+ If oSession.HasUnoProperty(_ControlModel, "SelectedItems") Then
+ If Not pvValue And UBound(_ControlModel.SelectedItems) > 0 Then ' Cancel selections when MultiSelect becomes False
+ lIndex = _ControlModel.SelectedItems(0)
+ _ControlModel.SelectedItems = Array(lIndex)
+ End If
+ End If
+ Case Else : GoTo CatchType
+ End Select
+ Case UCase("Page")
+ If Not ScriptForge.SF_Utils._Validate(pvValue, "Page", ScriptForge.V_NUMERIC) Then GoTo Finally
+ If oSession.HasUnoProperty(_ControlModel, "Step") Then _ControlModel.Step = CLng(pvValue)
+ Case UCase("Picture")
+ Select Case _ControlType
+ Case CTLBUTTON, CTLIMAGECONTROL
+ If Not ScriptForge.SF_Utils._ValidateFile(pvValue, "Picture") Then GoTo Finally
+ If oSession.HasUnoProperty(_ControlModel, "ImageURL") Then _ControlModel.ImageURL = ScriptForge.SF_FileSystem._ConvertToUrl(pvValue)
+ Case Else : GoTo CatchType
+ End Select
+ Case UCase("RowSource")
+ Select Case _ControlType
+ Case CTLCOMBOBOX, CTLLISTBOX
+ If Not IsArray(pvValue) Then
+ If Not ScriptForge.SF_Utils._Validate(pvValue, "RowSource", V_STRING) Then GoTo Finally
+ pvArray = Array(pvArray)
+ ElseIf Not ScriptForge.SF_Utils._ValidateArray(pvValue, "RowSource", 1, V_STRING, True) Then
+ GoTo Finally
+ End If
+ If oSession.HasUnoProperty(_ControlModel, "StringItemList") Then _ControlModel.StringItemList = pvValue
+ Case Else : GoTo CatchType
+ End Select
+ Case UCase("TipText")
+ If Not ScriptForge.SF_Utils._Validate(pvValue, "TipText", V_STRING) Then GoTo Finally
+ If oSession.HasUnoProperty(_ControlModel, "HelpText") Then _ControlModel.HelpText = pvValue
+ Case UCase("TripleState")
+ Select Case _ControlType
+ Case CTLCHECKBOX
+ If Not ScriptForge.SF_Utils._Validate(pvValue, "TripleState", ScriptForge.V_BOOLEAN) Then GoTo Finally
+ If oSession.HasUnoProperty(_ControlModel, "TriState") Then _ControlModel.TriState = pvValue
+ Case Else : GoTo CatchType
+ End Select
+ Case UCase("Value")
+ Select Case _ControlType
+ Case CTLBUTTON 'Boolean, toggle buttons only
+ If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_BOOLEAN) Then GoTo Finally
+ If oSession.HasUnoProperty(_ControlModel, "Toggle") And oSession.HasUnoProperty(_ControlModel, "State") Then
+ _ControlModel.State = Iif(pvValue, 1, 0)
+ End If
+ Case CTLCHECKBOX '0 = Not checked, 1 = Checked, 2 = Don't know
+ If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", Array(ScriptForge.V_BOOLEAN, ScriptForge.V_NUMERIC), Array(0, 1, 2, True, False)) Then GoTo Finally
+ If oSession.HasUnoProperty(_ControlModel, "State") Then
+ If VarType(pvValue) = ScriptForge.V_BOOLEAN Then pvValue = Iif(pvValue, 1, 0)
+ _ControlModel.State = pvValue
+ End If
+ Case CTLCOMBOBOX, CTLFILECONTROL, CTLPATTERNFIELD, CTLTEXTFIELD 'String
+ If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", V_STRING) Then GoTo Finally
+ If oSession.HasUnoProperty(_ControlModel, "Text") Then _ControlModel.Text = pvValue
+ Case CTLCURRENCYFIELD, CTLNUMERICFIELD 'Numeric
+ If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_NUMERIC) Then GoTo Finally
+ If oSession.HasUnoProperty(_ControlModel, "Value") Then _ControlModel.Value = pvValue
+ Case CTLDATEFIELD 'Date
+ If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", V_DATE) Then GoTo Finally
+ If oSession.HasUnoProperty(_ControlModel, "Date") Then
+ Set vSet = New com.sun.star.util.Date
+ vSet.Year = Year(pvValue)
+ vSet.Month = Month(pvValue)
+ vSet.Day = Day(pvValue)
+ _ControlModel.Date = vSet
+ End If
+ Case CTLFORMATTEDFIELD 'String or numeric
+ If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", Array(V_STRING, ScriptForge.V_NUMERIC)) Then GoTo Finally
+ If oSession.HasUnoProperty(_ControlModel, "EffectiveValue") Then _ControlModel.EffectiveValue = pvValue
+ Case CTLLISTBOX 'String or array of strings depending on MultiSelection
+ ' StringItemList is the list of the items displayed in the box
+ ' SelectedItems is the list of the indexes in StringItemList of the selected items
+ ' It can go beyond the limits of StringItemList
+ ' It can contain multiple values even if the listbox is not multiselect
+ If oSession.HasUnoProperty(_ControlModel, "StringItemList") And oSession.HasUnoProperty(_ControlModel, "SelectedItems") _
+ And oSession.HasUnoProperty(_ControlModel, "MultiSelection") Then
+ vSelection = Array()
+ If _ControlModel.MultiSelection Then
+ If Not ScriptForge.SF_Utils._ValidateArray(pvValue, "Value", 1, V_STRING, True) Then GoTo Finally
+ vList = _ControlModel.StringItemList
+ For i = LBound(pvValue) To UBound(pvValue)
+ sItem = pvValue(i)
+ lIndex = ScriptForge.SF_Array.IndexOf(vList, sItem)
+ If lIndex >= 0 Then vSelection = ScriptForge.SF_Array.Append(vSelection, lIndex)
+ Next i
+ Else
+ If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", V_STRING) Then GoTo Finally
+ lIndex = ScriptForge.SF_Array.IndexOf(_ControlModel.StringItemList, pvValue)
+ If lIndex >= 0 Then vSelection = Array(lIndex)
+ End If
+ _ControlModel.SelectedItems = vSelection
+ End If
+ Case CTLPROGRESSBAR 'Numeric
+ If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_NUMERIC) Then GoTo Finally
+ If oSession.HasUnoProperty(_ControlModel, "ProgressValueMin") Then
+ If pvValue < _ControlModel.ProgressValueMin Then pvValue = _ControlModel.ProgressValueMin
+ End If
+ If oSession.HasUnoProperty(_ControlModel, "ProgressValueMax") Then
+ If pvValue > _ControlModel.ProgressValueMax Then pvValue = _ControlModel.ProgressValueMax
+ End If
+ If oSession.HasUnoProperty(_ControlModel, "ProgressValue") Then _ControlModel.ProgressValue = pvValue
+ Case CTLRADIOBUTTON 'Boolean
+ If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_BOOLEAN) Then GoTo Finally
+ If oSession.HasUnoProperty(_ControlModel, "State") Then _ControlModel.State = Iif(pvValue, 1, 0)
+ Case CTLSCROLLBAR 'Numeric
+ If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_NUMERIC) Then GoTo Finally
+ If oSession.HasUnoProperty(_ControlModel, "ScrollValueMin") Then
+ If pvValue < _ControlModel.ScrollValueMin Then pvValue = _ControlModel.ScrollValueMin
+ End If
+ If oSession.HasUnoProperty(_ControlModel, "ScrollValueMax") Then
+ If pvValue > _ControlModel.ScrollValueMax Then pvValue = _ControlModel.ScrollValueMax
+ End If
+ If oSession.HasUnoProperty(_ControlModel, "ScrollValue") Then _ControlModel.ScrollValue = pvValue
+ Case CTLTIMEFIELD
+ If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", V_DATE) Then GoTo Finally
+ If oSession.HasUnoProperty(_ControlModel, "Time") Then
+ Set vSet = New com.sun.star.util.Time
+ vSet.Hours = Hour(pvValue)
+ vSet.Minutes = Minute(pvValue)
+ vSet.Seconds = Second(pvValue)
+ _ControlModel.Time = vSet
+ End If
+ Case Else : GoTo CatchType
+ End Select
+ Case UCase("Visible")
+ If Not ScriptForge.SF_Utils._Validate(pvValue, "Visible", ScriptForge.V_BOOLEAN) Then GoTo Finally
+ If oSession.HasUnoMethod(_ControlView, "setVisible") Then
+ If pvValue Then _ControlModel.EnableVisible = True
+ _ControlView.setVisible(pvValue)
+ End If
+ Case Else
+ bSet = False
+ End Select
+
+Finally:
+ _PropertySet = bSet
+ ScriptForge.SF_Utils._ExitFunction(cstThisSub)
+ Exit Function
+Catch:
+ GoTo Finally
+CatchType:
+ ScriptForge.SF_Exception.RaiseFatal(CONTROLTYPEERROR, _Name, _DialogName, _ControlType, psProperty)
+ GoTo Finally
+End Function ' SFDialogs.SF_DialogControl._PropertySet
+
+REM -----------------------------------------------------------------------------
+Private Function _Repr() As String
+''' Convert the Model instance to a readable string, typically for debugging purposes (DebugPrint ...)
+''' Args:
+''' Return:
+''' "[DIALOGCONTROL]: Name, Type (dialogname)
+ _Repr = "[DIALOGCONTROL]: " & _Name & ", " & _ControlType & " (" & _DialogName & ")"
+
+End Function ' SFDialogs.SF_DialogControl._Repr
+
+REM ============================================ END OF SFDIALOGS.SF_DIALOGCONTROL
+</script:module>
\ No newline at end of file
diff --git a/wizards/source/sfdialogs/SF_Register.xba b/wizards/source/sfdialogs/SF_Register.xba
new file mode 100644
index 000000000000..dba36894abf9
--- /dev/null
+++ b/wizards/source/sfdialogs/SF_Register.xba
@@ -0,0 +1,327 @@
+<?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_Register" 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 Explicit
+
+'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+''' SF_Register
+''' ===========
+''' The ScriptForge framework includes
+''' the master ScriptForge library
+''' a number of "associated" libraries SF*
+''' any user/contributor extension wanting to fit into the framework
+'''
+''' The main methods in this module allow the current library to cling to ScriptForge
+''' - RegisterScriptServices
+''' Register the list of services implemented by the current library
+'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+
+REM ================================================================= DEFINITIONS
+
+''' Event management of dialogs requires to being able to rebuild a Dialog object
+''' from its com.sun.star.awt.XControl - stardiv.Toolkit.UnoDialogControl UNO instance
+''' For that purpose, the started dialogs are buffered in a global array of _DialogCache types
+
+Type _DialogCache
+ Terminated As Boolean
+ XUnoDialog As Object
+ BasicDialog As Object
+End Type
+
+REM ================================================================== EXCEPTIONS
+
+Private Const DIALOGNOTFOUNDERROR = "DIALOGNOTFOUNDERROR"
+
+REM ============================================================== PUBLIC METHODS
+
+REM -----------------------------------------------------------------------------
+Public Sub RegisterScriptServices() As Variant
+''' Register into ScriptForge the list of the services implemented by the current library
+''' Each library pertaining to the framework must implement its own version of this method
+'''
+''' It consists in successive calls to the RegisterService() and RegisterEventManager() methods
+''' with 2 arguments:
+''' ServiceName: the name of the service as a case-insensitive string
+''' ServiceReference: the reference as an object
+''' If the reference refers to a module, then return the module as an object:
+''' GlobalScope.Library.Module
+''' If the reference is a class instance, then return a string referring to the method
+''' containing the New statement creating the instance
+''' "libraryname.modulename.function"
+
+ With GlobalScope.ScriptForge.SF_Services
+ .RegisterService("Dialog", "SFDialogs.SF_Register._NewDialog") ' Reference to the function initializing the service
+ .RegisterEventManager("DialogEvent", "SFDialogs.SF_Register._EventManager") ' Reference to the events manager
+ 'TODO
+ End With
+
+End Sub ' SFDialogs.SF_Register.RegisterScriptServices
+
+REM =========================================================== PRIVATE FUNCTIONS
+
+REM -----------------------------------------------------------------------------
+Private Function _AddDialogToCache(ByRef pvUnoDialog As Object _
+ , ByRef pvBasicDialog As Object _
+ ) As Long
+''' Add a new entry in the cache array with the references of the actual dialog
+''' If relevant, the last entry of the cache is reused.
+''' The cache is located in the global _SF_ variable
+''' Args:
+''' pvUnoDialog: the com.sun.star.awt.XControl - stardiv.Toolkit.UnoDialogControl of the dialog box
+''' pvBasicDialog: its corresponding Basic object
+''' Returns:
+''' The index of the new or modified entry
+
+Dim vCache As New _DialogCache ' Entry to be added
+Dim lIndex As Long ' UBound of _SF_.SFDialogs
+Dim vCacheArray As Variant ' Alias of _SF_.SFDialogs
+
+Try:
+ vCacheArray = _SF_.SFDialogs
+
+ If IsEmpty(vCacheArray) Then vCacheArray = Array()
+ lIndex = UBound(vCacheArray)
+ If lIndex < LBound(vCacheArray) Then
+ ReDim vCacheArray(0 To 0)
+ lIndex = 0
+ ElseIf Not vCacheArray(lIndex).Terminated Then ' Often last entry can be reused
+ lIndex = lIndex + 1
+ ReDim Preserve vCacheArray(0 To lIndex)
+ End If
+
+ With vCache
+ .Terminated = False
+ Set .XUnoDialog = pvUnoDialog
+ Set .BasicDialog = pvBasicDialog
+ End With
+ vCacheArray(lIndex) = vCache
+
+ _SF_.SFDialogs = vCacheArray
+
+Finally:
+ _AddDialogToCache = lIndex
+ Exit Function
+End Function ' SFDialogs.SF_Dialog._AddDialogToCache
+
+REM -----------------------------------------------------------------------------
+Private Sub _CleanCacheEntry(ByVal plIndex As Long)
+''' Clean the plIndex-th entry in the dialogs cache
+''' Args:
+''' plIndex: must fit within the actual boundaries of the cache, otherwise the request is ignored
+
+Dim vCache As New _DialogCache ' Cleaned entry
+
+ With _SF_
+ If Not IsArray(.SFDialogs) Then Exit Sub
+ If plIndex < LBound(.SFDialogs) Or plIndex > UBound(.SFDialogs) Then Exit Sub
+
+ With vCache
+ .Terminated = True
+ Set .XUnoDialog = Nothing
+ Set .BasicDialog = Nothing
+ End With
+ .SFDialogs(plIndex) = vCache
+ End With
+
+Finally:
+ Exit Sub
+End Sub ' SFDialogs.SF_Dialog._CleanCacheEntry
+
+REM -----------------------------------------------------------------------------
+Public Function _EventManager(Optional ByRef pvArgs As Variant) As Object
+''' Returns a Dialog or DialogControl object corresponding with the Basic dialog
+''' which triggered the event in argument
+''' This method should be triggered only thru the invocation of CreateScriptService
+''' Args:
+''' pvEvent: com.sun.star.xxx
+''' Returns:
+''' the output of a Dialog or DialogControl service or Nothing
+''' Example:
+''' Sub TriggeredByEvent(ByRef poEvent As Object)
+''' Dim oDlg As Object
+''' Set oDlg = CreateScriptService("SFDialogs.DialogEvent", poEvent)
+''' If Not IsNull(oDlg) Then
+''' ' ... (a valid dialog or one of its controls has been identified)
+''' End Sub
+
+Dim oSource As Object ' Return value
+Dim oEventSource As Object ' Event UNO source
+Dim vEvent As Variant ' Alias of pvArgs(0)
+Dim sSourceType As String ' Implementation name of event source
+Dim oDialog As Object ' com.sun.star.awt.XControl - stardiv.Toolkit.UnoDialogControl
+Dim bControl As Boolean ' True when control event
+
+ ' Never abort while an event is processed
+ If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Finally
+ Set oSource = Nothing
+
+Check:
+ If IsMissing(pvArgs) Or IsEmpty(pvArgs) Then pvArgs = Array()
+ If UBound(pvArgs) >= 0 Then vEvent = pvArgs(0) Else vEvent = Empty
+ If VarType(vEvent) <> ScriptForge.V_OBJECT Then GoTo Finally
+ If Not ScriptForge.SF_Session.HasUnoProperty(vEvent, "Source") Then GoTo Finally
+
+Try:
+ Set oEventSource = vEvent.Source
+ sSourceType = ScriptForge.SF_Session.UnoObjectType(oEventSource)
+
+ Set oDialog = Nothing
+ Select Case True
+ Case sSourceType = "stardiv.Toolkit.UnoDialogControl" ' A dialog
+ ' Search the dialog in the cache
+ Set oDialog = _FindDialogInCache(oEventSource)
+ bControl = False
+ Case Left(sSourceType, 16) = "stardiv.Toolkit." ' A dialog control
+ Set oDialog = _FindDialogInCache(oEventSource.Context)
+ bControl = True
+ Case Else
+ End Select
+
+ If Not IsNull(oDialog) Then
+ If bControl Then Set oSource = oDialog.Controls(oEventSource.Model.Name) Else Set oSource = oDialog
+ End If
+
+Finally:
+ Set _EventManager = oSource
+ Exit Function
+End Function ' SFDialogs.SF_Documents._EventManager
+
+REM -----------------------------------------------------------------------------
+Private Function _FindDialogInCache(ByRef poDialog As Object) As Object
+''' Find the dialog based on its XUnoDialog
+''' The dialog must not be terminated
+''' Returns:
+''' The corresponding Basic dialog part or Nothing
+
+Dim oBasicDialog As Object ' Return value
+Dim oCache As _DialogCache ' Entry in the cache
+
+ Set oBasicDialog = Nothing
+ For Each oCache In _SF_.SFDialogs
+ If EqualUnoObjects(poDialog, oCache.XUnoDialog) And Not oCache.Terminated Then
+ Set oBasicDialog = oCache.BasicDialog
+ Exit For
+ End If
+ Next oCache
+
+ Set _FindDialogInCache = oBasicDialog
+
+End Function ' SFDialogs.SF_Documents._FindDialogInCache
+
+REM -----------------------------------------------------------------------------
+Public Function _NewDialog(Optional ByVal pvArgs As Variant) As Object
+''' Create a new instance of the SF_Dialog class
+' Args:
+''' Container: either "GlobalScope" or a WindowName. Default = the active window
+''' see the definition of WindowName in the description of the UI service
+''' Library: the name of the library hosting the dialog. Defailt = "Standard"
+''' DialogName: The name of the dialog
+''' Library and dialog names are case-sensitive
+''' Returns: the instance or Nothing
+
+Dim oDialog As Object ' Return value
+Dim vContainer As Variant ' Alias of pvArgs(0)
+Dim vLibrary As Variant ' Alias of pvArgs(1)
+Dim vDialogName As Variant ' Alias of pvArgs(2)
+Dim oLibraries As Object ' com.sun.star.comp.sfx2.DialogLibraryContainer
+Dim oLibrary As Object ' com.sun.star.container.XNameAccess
+Dim o_DialogProvider As Object ' com.sun.star.io.XInputStreamProvider
+Dim oEnum As Object ' com.sun.star.container.XEnumeration
+Dim oComp As Object ' com.sun.star.lang.XComponent
+Dim vWindow As Window ' A single component
+Dim oUi As Object ' "UI" service
+Dim bFound As Boolean ' True if WindowName is found on the desktop
+Const cstService = "SFDialogs.Dialog"
+Const cstGlobal = "GlobalScope"
+
+ If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
+
+Check:
+ If IsMissing(pvArgs) Or IsEmpty(pvArgs) Then pvArgs = Array()
+ If Not IsArray(pvArgs) Then pvArgs = Array(pvArgs) ' Needed when _NewDialog called from _EventManager
+ If UBound(pvArgs) >= 0 Then vContainer = pvArgs(0) Else vContainer = ""
+ If UBound(pvArgs) >= 1 Then vLibrary = pvArgs(1) Else vLibrary = "Standard"
+ If UBound(pvArgs) >= 2 Then vDialogName = pvArgs(2) Else vDialogName = Empty ' Use Empty to force mandatory status
+ If Not ScriptForge.SF_Utils._Validate(vContainer, "Container", Array(V_STRING, ScriptForge.V_OBJECT)) Then GoTo Finally
+ If Not ScriptForge.SF_Utils._Validate(vLibrary, "Library", V_STRING) Then GoTo Finally
+ If Not ScriptForge.SF_Utils._Validate(vDialogName, "DialogName", V_STRING) Then GoTo Finally
+ Set oDialog = Nothing
+
+Try:
+ ' Determine the container and the library hosting the dialog
+ Set oLibraries = Nothing
+ If VarType(vContainer) = V_STRING Then
+ If UCase(vContainer) = UCase(cstGlobal) Then Set oLibraries = GlobalScope.DialogLibraries
+ End If
+ If IsNull(oLibraries) Then
+ Set oUi = ScriptForge.SF_Register.CreateScriptService("UI")
+ Select Case VarType(vContainer)
+ Case V_STRING
+ If Len(vContainer) > 0 Then
+ bFound = False
... etc. - the rest is truncated
More information about the Libreoffice-commits
mailing list