1100 lines
53 KiB
Java
1100 lines
53 KiB
Java
|
<?xml version="1.0" encoding="UTF-8"?>
|
||
|
|
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||
|
|
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_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>
|