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/DESTRUCTOR 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