1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099 |
- <?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/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
- </script:module>
|