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 <[email protected]> AuthorDate: Thu Nov 5 16:22:30 2020 +0100 Commit: Jean-Pierre Ledure <[email protected]> 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 _______________________________________________ Libreoffice-commits mailing list [email protected] https://lists.freedesktop.org/mailman/listinfo/libreoffice-commits
