3142 lines
No EOL
152 KiB
XML
3142 lines
No EOL
152 KiB
XML
<?xml version="1.0" encoding="UTF-8"?>
|
|
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
|
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Dialog" script:language="StarBasic" script:moduleType="normal">REM =======================================================================================================================
|
|
REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. ===
|
|
REM === The SFDialogs library is one of the associated libraries. ===
|
|
REM === Full documentation is available on https://help.libreoffice.org/ ===
|
|
REM =======================================================================================================================
|
|
|
|
Option Compatible
|
|
Option ClassModule
|
|
|
|
Option Explicit
|
|
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
''' SF_Dialog
|
|
''' =========
|
|
''' Management of dialogs. They may be defined with the Basic IDE or built from scratch
|
|
''' Each instance of the current class represents a single dialog box displayed to the user
|
|
'''
|
|
''' A dialog box can be displayed in modal or in non-modal modes
|
|
'''
|
|
''' In modal mode, the box is displayed and the execution of the macro process is suspended
|
|
''' until one of the OK or Cancel buttons is pressed. In the meantime, other user actions
|
|
''' executed on the box can trigger specific actions.
|
|
'''
|
|
''' In non-modal mode, the dialog box is "floating" on the user desktop and the execution
|
|
''' of the macro process continues normally
|
|
''' A dialog box disappears from memory after its explicit termination.
|
|
'''
|
|
''' Service invocation and usage:
|
|
'''
|
|
''' 1) when the dialog exists in some dialog libraries (= pre-defined with the Basic IDE):
|
|
''' Dim myDialog As Object, lButton As Long
|
|
''' Set myDialog = CreateScriptService("SFDialogs.Dialog", Container, Library, DialogName)
|
|
''' ' Args:
|
|
''' ' Container: "GlobalScope" for preinstalled libraries
|
|
''' ' A window name (see its definition in the ScriptForge.UI service)
|
|
''' ' "" (default) = the current document
|
|
''' ' Library: The (case-sensitive) name of a library contained in the container
|
|
''' ' Default = "Standard"
|
|
''' ' DialogName: a case-sensitive string designating the dialog where it is about
|
|
''' ' ... Initialize controls ...
|
|
''' lButton = myDialog.Execute() ' Default mode = Modal
|
|
''' If lButton = myDialog.OKBUTTON Then
|
|
''' ' ... Process controls and do what is needed
|
|
''' End If
|
|
''' myDialog.Terminate()
|
|
'''
|
|
''' 2) when the dialog is fully defined by code:
|
|
''' Dim myDialog As Object, oButton As Object lExec As Long
|
|
''' Set myDialog = CreateScriptService("SFDialogs.NewDialog", DialogName, Place)
|
|
''' ' Args:
|
|
''' ' DialogName: a case-sensitive string designating the dialog
|
|
''' Place: either
|
|
''' - an array with 4 elements: (X, Y, Width, Height)
|
|
''' - a com.sun.star.awt.Rectangle [X, Y, Width, Height]
|
|
''' (All elements are expressed in "Map AppFont" units).
|
|
''' ' ... Create controls with the CreateXXX(...) methods ..., e.g.
|
|
''' Set oButton = myDialog.CreateButton("OKButton", Place := Array(100, 100, 20, 10), Push := "OK")
|
|
''' lExec = myDialog.Execute() ' Default mode = Modal
|
|
''' If lExec = myDialog.OKBUTTON Then
|
|
''' ' ... Process controls and do what is needed
|
|
''' End If
|
|
''' myDialog.Terminate()
|
|
'''
|
|
'''
|
|
''' Detailed user documentation:
|
|
''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_dialog.html?DbPAR=BASIC
|
|
'''
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
|
|
REM ================================================================== EXCEPTIONS
|
|
|
|
Private Const DIALOGDEADERROR = "DIALOGDEADERROR"
|
|
Private Const PAGEMANAGERERROR = "PAGEMANAGERERROR"
|
|
Private Const DUPLICATECONTROLERROR = "DUPLICATECONTROLERROR"
|
|
|
|
REM ============================================================= PRIVATE MEMBERS
|
|
|
|
Private [Me] As Object
|
|
Private [_Parent] As Object
|
|
Private ObjectType As String ' Must be DIALOG
|
|
Private ServiceName As String
|
|
|
|
' Dialog location
|
|
Private _Container As String
|
|
Private _Library As String
|
|
Private _BuiltFromScratch As Boolean ' When True, dialog is not stored in a library
|
|
Private _BuiltInPython As Boolean ' Used only when _BuiltFromScratch = True
|
|
Private _Name As String
|
|
Private _CacheIndex As Long ' Index in cache storage
|
|
|
|
' Dialog UNO references
|
|
Private _DialogProvider As Object ' com.sun.star.io.XInputStreamProvider
|
|
Private _DialogControl As Object ' com.sun.star.awt.XControl - stardiv.Toolkit.UnoDialogControl
|
|
Private _DialogModel As Object ' com.sun.star.awt.XControlModel - stardiv.Toolkit.UnoControlDialogModel
|
|
|
|
' Dialog attributes
|
|
Private _Displayed As Boolean ' True after Execute()
|
|
Private _Modal As Boolean ' Set by Execute()
|
|
|
|
' Dialog initial position and dimensions in APPFONT units
|
|
Private _Left As Long
|
|
Private _Top As Long
|
|
Private _Width As Long
|
|
Private _Height As Long
|
|
|
|
' Page management
|
|
Type _PageManager
|
|
ControlName As String ' Case-sensitive name of control involved in page management
|
|
PageMgtType As Integer ' One of the PILOTCONTROL, TABCONTROL, NEXTCONTROL, BACKCONTROL constants
|
|
PageNumber As Long ' When > 0, the page to activate for tab controls
|
|
ListenerType As Integer ' One of the ITEMSTATECHANGED, ACTIONPERFORMED constants
|
|
End Type
|
|
|
|
Private _PageManagement As Variant ' Array of _PageManager objects, one entry by involved control
|
|
Private _ItemListener As Object ' com.sun.star.awt.XItemListener
|
|
Private _ActionListener As Object ' com.sun.star.awt.XActionListener
|
|
Private _LastPage As Long ' When > 0, the last page in a tabbed dialog
|
|
|
|
' Updatable events
|
|
' Next identifiers MUST be identical in both SF_Dialog and SF_DialogControl class modules
|
|
Private _FocusListener As Object ' com.sun.star.awt.XFocusListener
|
|
Private _OnFocusGained As String ' Script to invoke when dialog gets focus
|
|
Private _OnFocusLost As String ' Script to invoke when dialog loses focus
|
|
Private _FocusCounter As Integer ' Counts the number of events set on the listener
|
|
' ---
|
|
Private _KeyListener As Object ' com.sun.star.awt.XKeyListener
|
|
Private _OnKeyPressed As String ' Script to invoke when Key clicked in dialog
|
|
Private _OnKeyReleased As String ' Script to invoke when Key released in dialog
|
|
Private _KeyCounter As Integer ' Counts the number of events set on the listener
|
|
' ---
|
|
Private _MouseListener As Object ' com.sun.star.awt.XMouseListener
|
|
Private _OnMouseEntered As String ' Script to invoke when mouse enters dialog
|
|
Private _OnMouseExited As String ' Script to invoke when mouse leaves dialog
|
|
Private _OnMousePressed As String ' Script to invoke when mouse clicked in dialog
|
|
Private _OnMouseReleased As String ' Script to invoke when mouse released in dialog
|
|
Private _MouseCounter As Integer ' Counts the number of events set on the listener
|
|
' ---
|
|
Private _MouseMotionListener As Object ' com.sun.star.awt.XMouseMotionListener
|
|
Private _OnMouseDragged As String ' Script to invoke when mouse is dragged from the dialog
|
|
Private _OnMouseMoved As String ' Script to invoke when mouse is moved across the dialog
|
|
Private _MouseMotionCounter As Integer ' Counts the number of events set on the listener
|
|
|
|
' Persistent storage for controls
|
|
Private _ControlCache As Variant ' Array of control objects sorted like ElementNames of the Dialog model
|
|
|
|
REM ============================================================ MODULE CONSTANTS
|
|
|
|
' Dialog usual buttons
|
|
Private Const cstOKBUTTON = 1
|
|
Private Const cstCANCELBUTTON = 0
|
|
|
|
' Page management
|
|
Private Const PILOTCONTROL = 1
|
|
Private Const TABCONTROL = 2
|
|
Private Const BACKCONTROL = 3
|
|
Private Const NEXTCONTROL = 4
|
|
Private Const ITEMSTATECHANGED = 1
|
|
Private Const ACTIONPERFORMED = 2
|
|
|
|
REM ====================================================== CONSTRUCTOR/DESTRUCTOR
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Sub Class_Initialize()
|
|
Set [Me] = Nothing
|
|
Set [_Parent] = Nothing
|
|
ObjectType = "DIALOG"
|
|
ServiceName = "SFDialogs.Dialog"
|
|
_Container = ""
|
|
_Library = ""
|
|
_BuiltFromScratch = False
|
|
_BuiltInPython = False
|
|
_Name = ""
|
|
_CacheIndex = -1
|
|
Set _DialogProvider = Nothing
|
|
Set _DialogControl = Nothing
|
|
Set _DialogModel = Nothing
|
|
_Displayed = False
|
|
_Modal = True
|
|
|
|
_Left = SF_DialogUtils.MINPOSITION
|
|
_Top = SF_DialogUtils.MINPOSITION
|
|
_Width = -1
|
|
_Height = -1
|
|
|
|
_PageManagement = Array()
|
|
Set _ItemListener = Nothing
|
|
Set _ActionListener = Nothing
|
|
_LastPage = 0
|
|
|
|
Set _FocusListener = Nothing
|
|
_OnFocusGained = ""
|
|
_OnFocusLost = ""
|
|
_FocusCounter = 0
|
|
Set _KeyListener = Nothing
|
|
_OnKeyPressed = ""
|
|
_OnKeyReleased = ""
|
|
_KeyCounter = 0
|
|
Set _MouseListener = Nothing
|
|
_OnMouseEntered = ""
|
|
_OnMouseExited = ""
|
|
_OnMousePressed = ""
|
|
_OnMouseReleased = ""
|
|
_MouseCounter = 0
|
|
Set _MouseMotionListener = Nothing
|
|
_OnMouseDragged = ""
|
|
_OnMouseMoved = ""
|
|
_MouseMotionCounter = 0
|
|
_ControlCache = Array()
|
|
End Sub ' SFDialogs.SF_Dialog Constructor
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Sub Class_Terminate()
|
|
Call Class_Initialize()
|
|
End Sub ' SFDialogs.SF_Dialog Destructor
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Dispose() As Variant
|
|
If _CacheIndex >= 0 Then Terminate()
|
|
Call Class_Terminate()
|
|
Set Dispose = Nothing
|
|
End Function ' SFDialogs.SF_Dialog Explicit Destructor
|
|
|
|
REM ================================================================== PROPERTIES
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get CANCELBUTTON() As Variant
|
|
CANCELBUTTON = cstCANCELBUTTON
|
|
End Property ' SFDialogs.SF_Dialog.CANCELBUTTON (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Caption() As Variant
|
|
''' The Caption property refers to the title of the dialog
|
|
Caption = _PropertyGet("Caption")
|
|
End Property ' SFDialogs.SF_Dialog.Caption (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let Caption(Optional ByVal pvCaption As Variant)
|
|
''' Set the updatable property Caption
|
|
_PropertySet("Caption", pvCaption)
|
|
End Property ' SFDialogs.SF_Dialog.Caption (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Height() As Variant
|
|
''' The Height property refers to the height of the dialog box
|
|
Height = _PropertyGet("Height")
|
|
End Property ' SFDialogs.SF_Dialog.Height (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let Height(Optional ByVal pvHeight As Variant)
|
|
''' Set the updatable property Height
|
|
_PropertySet("Height", pvHeight)
|
|
End Property ' SFDialogs.SF_Dialog.Height (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get IsAlive() As Boolean
|
|
''' Returns True when the dialog has not been closed by the user
|
|
IsAlive = _PropertyGet("IsAlive")
|
|
End Property ' SFDocuments.SF_Dialog.IsAlive
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Modal() As Boolean
|
|
''' The Modal property specifies if the dialog box has been executed in modal mode
|
|
Modal = _PropertyGet("Modal")
|
|
End Property ' SFDialogs.SF_Dialog.Modal (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Name() As String
|
|
''' Return the name of the actual dialog
|
|
Name = _PropertyGet("Name")
|
|
End Property ' SFDialogs.SF_Dialog.Name
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OKBUTTON() As Variant
|
|
OKBUTTON = cstOKBUTTON
|
|
End Property ' SFDialogs.SF_Dialog.OKBUTTON (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnFocusGained() As Variant
|
|
''' Get the script associated with the OnFocusGained event
|
|
OnFocusGained = _PropertyGet("OnFocusGained")
|
|
End Property ' SFDialogs.SF_Dialog.OnFocusGained (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnFocusGained(Optional ByVal pvOnFocusGained As Variant)
|
|
''' Set the updatable property OnFocusGained
|
|
_PropertySet("OnFocusGained", pvOnFocusGained)
|
|
End Property ' SFDialogs.SF_Dialog.OnFocusGained (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnFocusLost() As Variant
|
|
''' Get the script associated with the OnFocusLost event
|
|
OnFocusLost = _PropertyGet("OnFocusLost")
|
|
End Property ' SFDialogs.SF_Dialog.OnFocusLost (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnFocusLost(Optional ByVal pvOnFocusLost As Variant)
|
|
''' Set the updatable property OnFocusLost
|
|
_PropertySet("OnFocusLost", pvOnFocusLost)
|
|
End Property ' SFDialogs.SF_Dialog.OnFocusLost (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnKeyPressed() As Variant
|
|
''' Get the script associated with the OnKeyPressed event
|
|
OnKeyPressed = _PropertyGet("OnKeyPressed")
|
|
End Property ' SFDialogs.SF_Dialog.OnKeyPressed (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnKeyPressed(Optional ByVal pvOnKeyPressed As Variant)
|
|
''' Set the updatable property OnKeyPressed
|
|
_PropertySet("OnKeyPressed", pvOnKeyPressed)
|
|
End Property ' SFDialogs.SF_Dialog.OnKeyPressed (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnKeyReleased() As Variant
|
|
''' Get the script associated with the OnKeyReleased event
|
|
OnKeyReleased = _PropertyGet("OnKeyReleased")
|
|
End Property ' SFDialogs.SF_Dialog.OnKeyReleased (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnKeyReleased(Optional ByVal pvOnKeyReleased As Variant)
|
|
''' Set the updatable property OnKeyReleased
|
|
_PropertySet("OnKeyReleased", pvOnKeyReleased)
|
|
End Property ' SFDialogs.SF_Dialog.OnKeyReleased (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnMouseDragged() As Variant
|
|
''' Get the script associated with the OnMouseDragged event
|
|
OnMouseDragged = _PropertyGet("OnMouseDragged")
|
|
End Property ' SFDialogs.SF_Dialog.OnMouseDragged (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnMouseDragged(Optional ByVal pvOnMouseDragged As Variant)
|
|
''' Set the updatable property OnMouseDragged
|
|
_PropertySet("OnMouseDragged", pvOnMouseDragged)
|
|
End Property ' SFDialogs.SF_Dialog.OnMouseDragged (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnMouseEntered() As Variant
|
|
''' Get the script associated with the OnMouseEntered event
|
|
OnMouseEntered = _PropertyGet("OnMouseEntered")
|
|
End Property ' SFDialogs.SF_Dialog.OnMouseEntered (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnMouseEntered(Optional ByVal pvOnMouseEntered As Variant)
|
|
''' Set the updatable property OnMouseEntered
|
|
_PropertySet("OnMouseEntered", pvOnMouseEntered)
|
|
End Property ' SFDialogs.SF_Dialog.OnMouseEntered (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnMouseExited() As Variant
|
|
''' Get the script associated with the OnMouseExited event
|
|
OnMouseExited = _PropertyGet("OnMouseExited")
|
|
End Property ' SFDialogs.SF_Dialog.OnMouseExited (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnMouseExited(Optional ByVal pvOnMouseExited As Variant)
|
|
''' Set the updatable property OnMouseExited
|
|
_PropertySet("OnMouseExited", pvOnMouseExited)
|
|
End Property ' SFDialogs.SF_Dialog.OnMouseExited (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnMouseMoved() As Variant
|
|
''' Get the script associated with the OnMouseMoved event
|
|
OnMouseMoved = _PropertyGet("OnMouseMoved")
|
|
End Property ' SFDialogs.SF_Dialog.OnMouseMoved (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnMouseMoved(Optional ByVal pvOnMouseMoved As Variant)
|
|
''' Set the updatable property OnMouseMoved
|
|
_PropertySet("OnMouseMoved", pvOnMouseMoved)
|
|
End Property ' SFDialogs.SF_Dialog.OnMouseMoved (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnMousePressed() As Variant
|
|
''' Get the script associated with the OnMousePressed event
|
|
OnMousePressed = _PropertyGet("OnMousePressed")
|
|
End Property ' SFDialogs.SF_Dialog.OnMousePressed (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnMousePressed(Optional ByVal pvOnMousePressed As Variant)
|
|
''' Set the updatable property OnMousePressed
|
|
_PropertySet("OnMousePressed", pvOnMousePressed)
|
|
End Property ' SFDialogs.SF_Dialog.OnMousePressed (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnMouseReleased() As Variant
|
|
''' Get the script associated with the OnMouseReleased event
|
|
OnMouseReleased = _PropertyGet("OnMouseReleased")
|
|
End Property ' SFDialogs.SF_Dialog.OnMouseReleased (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnMouseReleased(Optional ByVal pvOnMouseReleased As Variant)
|
|
''' Set the updatable property OnMouseReleased
|
|
_PropertySet("OnMouseReleased", pvOnMouseReleased)
|
|
End Property ' SFDialogs.SF_Dialog.OnMouseReleased (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Page() As Variant
|
|
''' A dialog may have several pages that can be traversed by the user step by step.
|
|
''' The Page property of the Dialog object defines which page of the dialog is active.
|
|
''' The Page property of a control defines the page of the dialog on which the control is visible.
|
|
''' For example, if a control has a page value of 1, it is only visible on page 1 of the dialog.
|
|
''' If the page value of the dialog is increased from 1 to 2, then all controls with a page value of 1 disappear
|
|
''' and all controls with a page value of 2 become visible.
|
|
Page = _PropertyGet("Page")
|
|
End Property ' SFDialogs.SF_Dialog.Page (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let Page(Optional ByVal pvPage As Variant)
|
|
''' Set the updatable property Page
|
|
_PropertySet("Page", pvPage)
|
|
End Property ' SFDialogs.SF_Dialog.Page (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Visible() As Variant
|
|
''' The Visible property is False before the Execute() statement
|
|
Visible = _PropertyGet("Visible")
|
|
End Property ' SFDialogs.SF_Dialog.Visible (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let Visible(Optional ByVal pvVisible As Variant)
|
|
''' Set the updatable property Visible
|
|
_PropertySet("Visible", pvVisible)
|
|
End Property ' SFDialogs.SF_Dialog.Visible (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Width() As Variant
|
|
''' The Width property refers to the Width of the dialog box
|
|
Width = _PropertyGet("Width")
|
|
End Property ' SFDialogs.SF_Dialog.Width (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let Width(Optional ByVal pvWidth As Variant)
|
|
''' Set the updatable property Width
|
|
_PropertySet("Width", pvWidth)
|
|
End Property ' SFDialogs.SF_Dialog.Width (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get XDialogModel() As Object
|
|
''' The XDialogModel property returns the model UNO object of the dialog
|
|
XDialogModel = _PropertyGet("XDialogModel")
|
|
End Property ' SFDialogs.SF_Dialog.XDialogModel (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get XDialogView() As Object
|
|
''' The XDialogView property returns the view UNO object of the dialog
|
|
XDialogView = _PropertyGet("XDialogView")
|
|
End Property ' SFDialogs.SF_Dialog.XDialogView (get)
|
|
|
|
REM ===================================================================== METHODS
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Activate() As Boolean
|
|
''' Set the focus on the current dialog instance
|
|
''' Probably called from after an event occurrence or to focus on a non-modal dialog
|
|
''' Args:
|
|
''' Returns:
|
|
''' True if focusing is successful
|
|
''' Example:
|
|
''' Dim oDlg As Object
|
|
''' Set oDlg = CreateScriptService(,, "myDialog") ' Dialog stored in current document's standard library
|
|
''' oDlg.Activate()
|
|
|
|
Dim bActivate As Boolean ' Return value
|
|
Const cstThisSub = "SFDialogs.Dialog.Activate"
|
|
Const cstSubArgs = ""
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bActivate = False
|
|
|
|
Check:
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
End If
|
|
Try:
|
|
If Not IsNull(_DialogControl) Then
|
|
_DialogControl.setVisible(True)
|
|
_DialogControl.setFocus()
|
|
bActivate = True
|
|
End If
|
|
|
|
Finally:
|
|
Activate = bActivate
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDialogs.SF_Dialog.Activate
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Center(Optional ByRef Parent As Variant) As Boolean
|
|
''' Center the actual dialog instance in the middle of a parent window
|
|
''' Without arguments, the method centers the dialog in the middle of the current window
|
|
''' Args:
|
|
''' Parent: an object, either
|
|
''' - a ScriptForge dialog object
|
|
''' - a ScriptForge document (Calc, Base, ...) object
|
|
''' Returns:
|
|
''' True when successful
|
|
''' Examples:
|
|
''' Sub TriggerEvent(oEvent As Object)
|
|
''' Dim oDialog1 As Object, oDialog2 As Object, lExec As Long
|
|
''' Set oDialog1 = CreateScriptService("DialogEvent", oEvent) ' The dialog having caused the event
|
|
''' Set oDialog2 = CreateScriptService("Dialog", ...) ' Open a second dialog
|
|
''' oDialog2.Center(oDialog1)
|
|
''' lExec = oDialog2.Execute()
|
|
''' Select Case lExec
|
|
''' ...
|
|
''' End Sub
|
|
|
|
Dim bCenter As Boolean ' Return value
|
|
Dim oUi As Object ' ScriptForge.SF_UI
|
|
Dim oObjDesc As Object ' _ObjectDescriptor type
|
|
Dim sObjectType As String ' Can be uno or sf object type
|
|
Dim oParent As Object ' UNO alias of parent
|
|
Dim oParentPosSize As Object ' Parent com.sun.star.awt.Rectangle
|
|
Dim lParentX As Long ' X position of parent dialog
|
|
Dim lParentY As Long ' Y position of parent dialog
|
|
Dim oPosSize As Object ' Dialog com.sun.star.awt.Rectangle
|
|
Const cstThisSub = "SFDialogs.Dialog.Center"
|
|
Const cstSubArgs = "[Parent]"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bCenter = False
|
|
|
|
Check:
|
|
If IsMissing(Parent) Or IsEmpty(Parent) Then Set Parent = Nothing
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not ScriptForge.SF_Utils._Validate(Parent, "Parent", ScriptForge.V_OBJECT) Then GoTo Finally
|
|
End If
|
|
|
|
Set oParentPosSize = Nothing
|
|
lParentX = 0 : lParentY = 0
|
|
If IsNull(Parent) Then
|
|
Set oUi = CreateScriptService("UI")
|
|
Set oParentPosSize = oUi._PosSize() ' Return the position and dimensions of the active window
|
|
Else
|
|
' Determine the object type
|
|
Set oObjDesc = ScriptForge.SF_Utils._VarTypeObj(Parent)
|
|
If oObjDesc.iVarType = ScriptForge.V_SFOBJECT Then ' ScriptForge object
|
|
sObjectType = oObjDesc.sObjectType
|
|
' Document or dialog ?
|
|
If Not ScriptForge.SF_Array.Contains(Array("BASE", "CALC", "DIALOG", "DOCUMENT", "WRITER"), sObjectType, CaseSensitive := True) Then GoTo Finally
|
|
If sObjectType = "DIALOG" Then
|
|
Set oParent = Parent._DialogControl
|
|
Set oParentPosSize = oParent.getPosSize()
|
|
lParentX = oParentPosSize.X
|
|
lParentY = oParentPosSize.Y
|
|
Else
|
|
Set oParent = Parent._Component.getCurrentController().Frame.getComponentWindow()
|
|
Set oParentPosSize = oParent.getPosSize()
|
|
End If
|
|
Else
|
|
GoTo Finally ' UNO object, do nothing
|
|
End If
|
|
End If
|
|
If IsNull(oParentPosSize) Then GoTo Finally
|
|
|
|
Try:
|
|
Set oPosSize = _DialogControl.getPosSize()
|
|
With oPosSize
|
|
_DialogControl.setPosSize( _
|
|
lParentX + CLng((oParentPosSize.Width - .Width) \ 2) _
|
|
, lParentY + CLng((oParentPosSize.Height - .Height) \ 2) _
|
|
, .Width _
|
|
, .Height _
|
|
, com.sun.star.awt.PosSize.POSSIZE)
|
|
End With
|
|
bCenter = True
|
|
|
|
Finally:
|
|
Center = bCenter
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SF_Documents.SF_Dialog.Center
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function CloneControl(Optional ByVal SourceName As Variant _
|
|
, Optional ByVal ControlName As Variant _
|
|
, Optional ByVal Left As Variant _
|
|
, Optional ByVal Top As Variant _
|
|
) As Object
|
|
''' Duplicate an existing control of any type in the actual dialog.
|
|
''' The duplicated control is left unchanged. The new control can be relocated.
|
|
''' Specific args:
|
|
''' SourceName: the name of the control to duplicate
|
|
''' ControlName: the name of the new control. It must not exist yet
|
|
''' Left, Top: the coordinates of the new control expressed in "Map AppFont" units
|
|
''' Returns:
|
|
''' an instance of the SF_DialogControl class or Nothing
|
|
''' Example:
|
|
''' Set myButton2 = dialog.CloneControl("Button1", "Button2", 30, 30)
|
|
|
|
Dim oControl As Object ' Return value
|
|
Dim oSourceModel As Object ' com.sun.star.awt.XControlModel of the source
|
|
Dim oControlModel As Object ' com.sun.star.awt.XControlModel of the new control
|
|
Const cstThisSub = "SFDialogs.Dialog.CloneControl"
|
|
Const cstSubArgs = "SourceName, ControlName, [Left=1], [Top=1]"
|
|
|
|
Check:
|
|
Set oControl = Nothing
|
|
|
|
If IsMissing(Left) Or IsEmpty(Left) Then Left = 1
|
|
If IsMissing(Top) Or IsEmpty(Top) Then Top = 1
|
|
|
|
If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place := Null) Then GoTo Finally
|
|
|
|
If Not ScriptForge.SF_Utils._Validate(SourceName, "SourceName", V_String, _DialogModel.getElementNames(), True) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Left, "Left", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Top, "Top", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
|
|
Try:
|
|
' All control types are presumes cloneable
|
|
Set oSourceModel = _DialogModel.getByName(SourceName)
|
|
Set oControlModel = oSourceModel.createClone()
|
|
oControlModel.Name = ControlName
|
|
|
|
' Create the control
|
|
Set oControl = _CreateNewControl(oControlModel, ControlName, Array(Left, Top))
|
|
|
|
Finally:
|
|
Set CloneControl = oControl
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDialogs.SF_Dialog.CloneControl
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Controls(Optional ByVal ControlName As Variant) As Variant
|
|
''' Return either
|
|
''' - the list of the controls contained in the dialog
|
|
''' - a dialog control object based on its name
|
|
''' Args:
|
|
''' ControlName: a valid control name as a case-sensitive string. If absent the list is returned
|
|
''' Returns:
|
|
''' A zero-base array of strings if ControlName is absent
|
|
''' An instance of the SF_DialogControl class if ControlName exists
|
|
''' Exceptions:
|
|
''' ControlName is invalid
|
|
''' Example:
|
|
''' Dim myDialog As Object, myList As Variant, myControl As Object
|
|
''' Set myDialog = CreateScriptService("SFDialogs.Dialog", Container, Library, DialogName)
|
|
''' myList = myDialog.Controls()
|
|
''' Set myControl = myDialog.Controls("myTextBox")
|
|
|
|
Dim oControl As Object ' The new control class instance
|
|
Dim lIndexOfNames As Long ' Index in ElementNames array. Used to access _ControlCache
|
|
Dim vControl As Variant ' Alias of _ControlCache entry
|
|
Const cstThisSub = "SFDialogs.Dialog.Controls"
|
|
Const cstSubArgs = "[ControlName]"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
|
|
Check:
|
|
If IsMissing(ControlName) Or IsEmpty(ControlName) Then ControlName = ""
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(ControlName, "ControlName", V_STRING) Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
If Len(ControlName) = 0 Then
|
|
Controls = _DialogModel.getElementNames()
|
|
Else
|
|
If Not _DialogModel.hasByName(ControlName) Then GoTo CatchNotFound
|
|
lIndexOfNames = ScriptForge.IndexOf(_DialogModel.getElementNames(), ControlName, CaseSensitive := True)
|
|
' Reuse cache when relevant
|
|
vControl = _ControlCache(lIndexOfNames)
|
|
If IsEmpty(vControl) Then
|
|
' Create the new dialog control class instance
|
|
Set oControl = New SF_DialogControl
|
|
With oControl
|
|
._Name = ControlName
|
|
Set .[Me] = oControl
|
|
Set .[_Parent] = [Me]
|
|
._IndexOfNames = ScriptForge.IndexOf(_DialogModel.getElementNames(), ControlName, CaseSensitive := True)
|
|
._DialogName = _Name
|
|
Set ._ControlModel = _DialogModel.getByName(ControlName)
|
|
Set ._ControlView = _DialogControl.getControl(ControlName)
|
|
._ControlView.setModel(._ControlModel)
|
|
._Initialize()
|
|
End With
|
|
Else
|
|
Set oControl = vControl
|
|
End If
|
|
Set Controls = oControl
|
|
End If
|
|
|
|
Finally:
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
CatchNotFound:
|
|
ScriptForge.SF_Utils._Validate(ControlName, "ControlName", V_STRING, _DialogModel.getElementNames(), True)
|
|
GoTo Finally
|
|
End Function ' SFDialogs.SF_Dialog.Controls
|
|
|
|
''' CreateXXX functions:
|
|
''' -------------------
|
|
''' Common arguments:
|
|
''' ControlName: the name of the new control. It must not exist yet.
|
|
''' Place: either
|
|
''' - an array with 4 elements: (X, Y, Width, Height)
|
|
''' - a com.sun.star.awt.Rectangle [X, Y, Width, Height]
|
|
''' All elements are expressed in "Map AppFont" units.
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function CreateButton(Optional ByVal ControlName As Variant _
|
|
, Optional ByRef Place As Variant _
|
|
, Optional ByVal Toggle As Variant _
|
|
, Optional ByVal Push As Variant _
|
|
) As Object
|
|
''' Create a new control of type Button in the actual dialog.
|
|
''' Specific args:
|
|
''' Toggle: when True a Toggle button is created. Default = False
|
|
''' Push: "OK", "CANCEL" or "" (default)
|
|
''' Returns:
|
|
''' an instance of the SF_DialogControl class or Nothing
|
|
''' Example:
|
|
''' Set myButton = dialog.CreateButton("Button1", Array(20, 20, 60, 15))
|
|
|
|
Dim oControl As Object ' Return value
|
|
Dim iPush As Integer ' Alias of Push
|
|
Dim vPropNames As Variant ' Array of names of specific arguments
|
|
Dim vPropValues As Variant ' Array of values of specific arguments
|
|
Const cstThisSub = "SFDialogs.Dialog.CreateButton"
|
|
Const cstSubArgs = "ControlName, Place, [Toggle=False], [Push=""""|""OK""|""CANCEL""]"
|
|
|
|
Check:
|
|
Set oControl = Nothing
|
|
If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally
|
|
|
|
If IsMissing(Toggle) Or IsEmpty(Toggle) Then Toggle = False
|
|
If IsMissing(Push) Or IsEmpty(Push) Then Push = ""
|
|
If Not ScriptForge.SF_Utils._Validate(Toggle, "Toggle", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Push, "Push", V_STRING, Array("", "OK", "CANCEL")) Then GoTo Finally
|
|
|
|
Try:
|
|
' Handle specific arguments
|
|
Select Case UCase(Push)
|
|
Case "" : iPush = com.sun.star.awt.PushButtonType.STANDARD
|
|
Case "OK" : iPush = com.sun.star.awt.PushButtonType.OK
|
|
Case "CANCEL" : iPush = com.sun.star.awt.PushButtonType.CANCEL
|
|
End Select
|
|
vPropNames = Array("Toggle", "PushButtonType")
|
|
vPropValues = Array(CBool(Toggle), iPush)
|
|
|
|
' Create the control
|
|
Set oControl = _CreateNewControl("UnoControlButtonModel", ControlName, Place, vPropNames, vPropValues)
|
|
|
|
Finally:
|
|
Set CreateButton = oControl
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
End Function ' SFDialogs.SF_Dialog.CreateButton
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function CreateCheckBox(Optional ByVal ControlName As Variant _
|
|
, Optional ByRef Place As Variant _
|
|
, Optional ByVal MultiLine As Variant _
|
|
) As Object
|
|
''' Create a new control of type CheckBox in the actual dialog.
|
|
''' Specific args:
|
|
''' MultiLine: When True (default = False), the caption may be displayed on more than one line
|
|
''' Returns:
|
|
''' an instance of the SF_DialogControl class or Nothing
|
|
''' Example:
|
|
''' Set myCheckBox = dialog.CreateCheckBox("CheckBox1", Array(20, 20, 60, 15), MultiLine := True)
|
|
|
|
Dim oControl As Object ' Return value
|
|
Dim vPropNames As Variant ' Array of names of specific arguments
|
|
Dim vPropValues As Variant ' Array of values of specific arguments
|
|
Const cstThisSub = "SFDialogs.Dialog.CreateCheckBox"
|
|
Const cstSubArgs = "ControlName, Place, [MultiLine=False]"
|
|
|
|
Check:
|
|
Set oControl = Nothing
|
|
If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally
|
|
|
|
If IsMissing(MultiLine) Or IsEmpty(MultiLine) Then MultiLine = False
|
|
If Not ScriptForge.SF_Utils._Validate(MultiLine, "MultiLine", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
|
|
Try:
|
|
' Manage specific properties
|
|
vPropNames = Array("VisualEffect", "MultiLine")
|
|
vPropValues = Array(1, CBool(MultiLine))
|
|
|
|
' Create the control
|
|
Set oControl = _CreateNewControl("UnoControlCheckBoxModel", ControlName, Place, vPropNames, vPropValues)
|
|
|
|
Finally:
|
|
Set CreateCheckBox = oControl
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
End Function ' SFDialogs.SF_Dialog.CreateCheckBox
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function CreateComboBox(Optional ByVal ControlName As Variant _
|
|
, Optional ByRef Place As Variant _
|
|
, Optional ByVal Border As Variant _
|
|
, Optional ByVal Dropdown As Variant _
|
|
, Optional ByVal LineCount As Variant _
|
|
) As Object
|
|
''' Create a new control of type ComboBox in the actual dialog.
|
|
''' Specific args:
|
|
''' Border: "3D" (default) or "FLAT" or "NONE"
|
|
''' Dropdown: When True (default), a drop down button is displayed
|
|
''' LineCount: Specifies the maximum line count displayed in the drop down (default = 5)
|
|
''' Returns:
|
|
''' an instance of the SF_DialogControl class or Nothing
|
|
''' Example:
|
|
''' Set myComboBox = dialog.CreateComboBox("ComboBox1", Array(20, 20, 60, 15), Dropdown := True)
|
|
|
|
Dim oControl As Object ' Return value
|
|
Dim iBorder As Integer ' Alias of border
|
|
Dim vPropNames As Variant ' Array of names of specific arguments
|
|
Dim vPropValues As Variant ' Array of values of specific arguments
|
|
Const cstThisSub = "SFDialogs.Dialog.CreateComboBox"
|
|
Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""], [Dropdown=True], [LineCount=5]"
|
|
|
|
Check:
|
|
Set oControl = Nothing
|
|
If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally
|
|
|
|
If IsMissing(Border) Or IsEmpty(Border) Then Border = "3D"
|
|
If IsMissing(Dropdown) Or IsEmpty(Dropdown) Then Dropdown = True
|
|
If IsMissing(LineCount) Or IsEmpty(LineCount) Then LineCount = 5
|
|
|
|
If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Dropdown, "Dropdown", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(LineCount, "LineCount", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
|
|
Try:
|
|
' Manage specific properties
|
|
iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border)
|
|
vPropNames = Array("Border", "Dropdown", "LineCount")
|
|
vPropValues = Array(iBorder, CBool(Dropdown), CInt(LineCount))
|
|
|
|
' Create the control
|
|
Set oControl = _CreateNewControl("UnoControlComboBoxModel", ControlName, Place, vPropNames, vPropValues)
|
|
|
|
Finally:
|
|
Set CreateComboBox = oControl
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
End Function ' SFDialogs.SF_Dialog.CreateComboBox
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function CreateCurrencyField(Optional ByVal ControlName As Variant _
|
|
, Optional ByRef Place As Variant _
|
|
, Optional ByVal Border As Variant _
|
|
, Optional ByVal SpinButton As Variant _
|
|
, Optional ByVal MinValue As Variant _
|
|
, Optional ByVal MaxValue As Variant _
|
|
, Optional ByVal Increment As Variant _
|
|
, Optional ByVal Accuracy As Variant _
|
|
) As Object
|
|
''' Create a new control of type CurrencyField in the actual dialog.
|
|
''' Specific args:
|
|
''' Border: "3D" (default) or "FLAT" or "NONE"
|
|
''' SpinButton:: when True (default = False), a spin button is present
|
|
''' MinValue: the smallest value that can be entered in the control. Default = -1000000
|
|
''' MaxValue: the largest value that can be entered in the control. Default = +1000000
|
|
''' Increment: the step when the spin button is pressed. Default = 1
|
|
''' Accuracy: specifies the decimal accuracy. Default = 2 decimal digits
|
|
''' Returns:
|
|
''' an instance of the SF_DialogControl class or Nothing
|
|
''' Example:
|
|
''' Set myCurrencyField = dialog.CreateCurrencyField("CurrencyField1", Array(20, 20, 60, 15), SpinButton := True)
|
|
|
|
Dim oControl As Object ' Return value
|
|
Dim iBorder As Integer ' Alias of border
|
|
Dim vPropNames As Variant ' Array of names of specific arguments
|
|
Dim vPropValues As Variant ' Array of values of specific arguments
|
|
Const cstThisSub = "SFDialogs.Dialog.CreateCurrencyField"
|
|
Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""], [Dropdown=False], [SpinButton=False]" _
|
|
& ", [MinValue=-1000000], MaxValue=+1000000], [Increment=1], [Accuracy=2]"
|
|
|
|
Check:
|
|
Set oControl = Nothing
|
|
If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally
|
|
|
|
If IsMissing(Border) Or IsEmpty(Border) Then Border = "3D"
|
|
If IsMissing(SpinButton) Or IsEmpty(SpinButton) Then SpinButton = False
|
|
If IsMissing(MinValue) Or IsEmpty(MinValue) Then MinValue = -1000000.00
|
|
If IsMissing(MaxValue) Or IsEmpty(MaxValue) Then MaxValue = +1000000.00
|
|
If IsMissing(Increment) Or IsEmpty(Increment) Then Increment = 1.00
|
|
If IsMissing(Accuracy) Or IsEmpty(Accuracy) Then Accuracy = 2
|
|
|
|
If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(SpinButton, "SpinButton", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(MinValue, "MinValue", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(MaxValue, "MaxValue", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Increment, "Increment", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Accuracy, "Accuracy", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
|
|
Try:
|
|
' Manage specific properties
|
|
iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border)
|
|
vPropNames = Array("Border", "Spin", "ValueMin", "ValueMax", "ValueStep", "DecimalAccuracy")
|
|
vPropValues = Array(iBorder, CBool(SpinButton), CDbl(MinValue), CDbl(MaxValue), CDbl(Increment), CInt(Accuracy))
|
|
|
|
' Create the control
|
|
Set oControl = _CreateNewControl("UnoControlCurrencyFieldModel", ControlName, Place, vPropNames, vPropValues)
|
|
|
|
Finally:
|
|
Set CreateCurrencyField = oControl
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
End Function ' SFDialogs.SF_Dialog.CreateCurrencyField
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function CreateDateField(Optional ByVal ControlName As Variant _
|
|
, Optional ByRef Place As Variant _
|
|
, Optional ByVal Border As Variant _
|
|
, Optional ByVal Dropdown As Variant _
|
|
, Optional ByVal MinDate As Variant _
|
|
, Optional ByVal MaxDate As Variant _
|
|
) As Object
|
|
''' Create a new control of type DateField in the actual dialog.
|
|
''' Specific args:
|
|
''' Border: "3D" (default) or "FLAT" or "NONE"
|
|
''' Dropdown:: when True (default = False), a dropdown button is shown
|
|
''' MinDate: the smallest date that can be entered in the control. Default = 1900-01-01
|
|
''' MaxDate: the largest Date that can be entered in the control. Default = 2200-12-31
|
|
''' Returns:
|
|
''' an instance of the SF_DialogControl class or Nothing
|
|
''' Example:
|
|
''' Set myDateField = dialog.CreateDateField("DateField1", Array(20, 20, 60, 15), Dropdown := True)
|
|
|
|
Dim oControl As Object ' Return Date
|
|
Dim iBorder As Integer ' Alias of border
|
|
Dim oMinDate As New com.sun.star.util.Date
|
|
Dim oMaxDate As New com.sun.star.util.Date
|
|
Dim vFormats As Variant ' List of available date formats
|
|
Dim vPropNames As Variant ' Array of names of specific arguments
|
|
Dim vPropValues As Variant ' Array of values of specific arguments
|
|
Const cstThisSub = "SFDialogs.Dialog.CreateDateField"
|
|
Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""], [Dropdown=False]" _
|
|
& ", [MinDate=DateSerial(1900, 1, 1)], [MaxDate=DateSerial(2200, 12, 31)]"
|
|
|
|
Check:
|
|
Set oControl = Nothing
|
|
If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally
|
|
|
|
If IsMissing(Border) Or IsEmpty(Border) Then Border = "3D"
|
|
If IsMissing(Dropdown) Or IsEmpty(Dropdown) Then Dropdown = False
|
|
If IsMissing(MinDate) Or IsEmpty(MinDate) Then MinDate = DateSerial(1900, 1, 1)
|
|
If IsMissing(MaxDate) Or IsEmpty(MaxDate) Then MaxDate = DateSerial(2200, 12, 31)
|
|
|
|
If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Dropdown, "Dropdown", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(MinDate, "MinDate", ScriptForge.V_DATE) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(MaxDate, "MaxDate", ScriptForge.V_DATE) Then GoTo Finally
|
|
vFormats = SF_DialogUtils._FormatsList("DateField")
|
|
|
|
Try:
|
|
' Manage specific properties
|
|
iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border)
|
|
With oMinDate
|
|
.Year = Year(MinDate) : .Month = Month(MinDate) : .Day = Day(MinDate)
|
|
End With
|
|
With oMaxDate
|
|
.Year = Year(MaxDate) : .Month = Month(MaxDate) : .Day = Day(MaxDate)
|
|
End With
|
|
vPropNames = Array("Border", "Dropdown", "DateMin", "DateMax", "DateFormat")
|
|
vPropValues = Array(iBorder, CBool(Dropdown), oMinDate, oMaxDate, CInt(ScriptForge.SF_Array.IndexOf(vFormats(), "Standard (short)")))
|
|
|
|
' Create the control
|
|
Set oControl = _CreateNewControl("UnoControlDateFieldModel", ControlName, Place, vPropNames, vPropValues)
|
|
|
|
Finally:
|
|
Set CreateDateField = oControl
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
End Function ' SFDialogs.SF_Dialog.CreateDateField
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function CreateFileControl(Optional ByVal ControlName As Variant _
|
|
, Optional ByRef Place As Variant _
|
|
, Optional ByVal Border As Variant _
|
|
) As Object
|
|
''' Create a new control of type FileControl in the actual dialog.
|
|
''' Specific args:
|
|
''' Border: "3D" (default) or "FLAT" or "NONE"
|
|
''' Returns:
|
|
''' an instance of the SF_DialogControl class or Nothing
|
|
''' Example:
|
|
''' Set myFileControl = dialog.CreateFileControl("FileControl1", Array(20, 20, 60, 15))
|
|
|
|
Dim oControl As Object ' Return value
|
|
Dim iBorder As Integer ' Alias of border
|
|
Dim vPropNames As Variant ' Array of names of specific arguments
|
|
Dim vPropValues As Variant ' Array of values of specific arguments
|
|
Const cstThisSub = "SFDialogs.Dialog.CreateFileControl"
|
|
Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""]"
|
|
|
|
Check:
|
|
Set oControl = Nothing
|
|
If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally
|
|
|
|
If IsMissing(Border) Or IsEmpty(Border) Then Border = "3D"
|
|
If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally
|
|
|
|
Try:
|
|
' Manage specific properties
|
|
iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border)
|
|
vPropNames = Array("Border")
|
|
vPropValues = Array(iBorder)
|
|
|
|
' Create the control
|
|
Set oControl = _CreateNewControl("UnoControlFileControlModel", ControlName, Place, vPropNames, vPropValues)
|
|
|
|
Finally:
|
|
Set CreateFileControl = oControl
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDialogs.SF_Dialog.CreateFileControl
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function CreateFixedLine(Optional ByVal ControlName As Variant _
|
|
, Optional ByRef Place As Variant _
|
|
, Optional ByVal Orientation As Variant _
|
|
) As Object
|
|
''' Create a new control of type FixedLine in the actual dialog.
|
|
''' Specific args:
|
|
''' Orientation: "H[orizontal]" or "V[ertical]".
|
|
''' Returns:
|
|
''' an instance of the SF_DialogControl class or Nothing
|
|
''' Example:
|
|
''' Set myFixedLine = dialog.CreateFixedLine("FixedLine1", Array(20, 20, 60, 15), Orientation := "vertical")
|
|
|
|
Dim oControl As Object ' Return value
|
|
Dim vPropNames As Variant ' Array of names of specific arguments
|
|
Dim vPropValues As Variant ' Array of values of specific arguments
|
|
Const cstThisSub = "SFDialogs.Dialog.CreateFixedLine"
|
|
Const cstSubArgs = "ControlName, Place, Orientation=""H""|""Horizontal""|""V""|""Vertical"""
|
|
|
|
Check:
|
|
Set oControl = Nothing
|
|
If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally
|
|
|
|
If Not ScriptForge.SF_Utils._Validate(Orientation, "Orientation", V_STRING, Array("H", "Horizontal", "V", "Vertical")) Then GoTo Finally
|
|
|
|
Try:
|
|
' Manage specific properties
|
|
vPropNames = Array("Orientation")
|
|
vPropValues = Array(CLng(Iif(Left(UCase(Orientation), 1) = "V", 1, 0)))
|
|
|
|
' Create the control
|
|
Set oControl = _CreateNewControl("UnoControlFixedLineModel", ControlName, Place, vPropNames, vPropValues)
|
|
|
|
Finally:
|
|
Set CreateFixedLine = oControl
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
End Function ' SFDialogs.SF_Dialog.CreateFixedLine
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function CreateFixedText(Optional ByVal ControlName As Variant _
|
|
, Optional ByRef Place As Variant _
|
|
, Optional ByVal Border As Variant _
|
|
, Optional ByVal MultiLine As Variant _
|
|
, Optional ByVal Align As Variant _
|
|
, Optional ByVal VerticalAlign As Variant _
|
|
) As Object
|
|
''' Create a new control of type FixedText in the actual dialog.
|
|
''' Specific args:
|
|
''' Border: "NONE" (default) or "FLAT" or "3D"
|
|
''' MultiLine: When True (default = False), the caption may be displayed on more than one line
|
|
''' Align: horizontal alignment, "LEFT" (default) or "CENTER" or "RIGHT"
|
|
''' VerticalAlign: vertical alignment, "TOP" (default) or "MIDDLE" or "BOTTOM"
|
|
''' Returns:
|
|
''' an instance of the SF_DialogControl class or Nothing
|
|
''' Example:
|
|
''' Set myFixedText = dialog.CreateFixedText("FixedText1", Array(20, 20, 60, 15), MultiLine := True)
|
|
|
|
Dim oControl As Object ' Return value
|
|
Dim iBorder As Integer ' Alias of border
|
|
Dim iAlign As Integer ' Alias of Align
|
|
Dim iVerticalAlign As Integer ' Alias of VerticalAlign
|
|
Dim vPropNames As Variant ' Array of names of specific arguments
|
|
Dim vPropValues As Variant ' Array of values of specific arguments
|
|
Const cstThisSub = "SFDialogs.Dialog.CreateFixedText"
|
|
Const cstSubArgs = "ControlName, Place, [MultiLine=False], [Border=""NONE""|""FLAT""|""3D""]" _
|
|
& ", [Align=""LEFT""|""CENTER""|""RIGHT""], [VerticalAlign=""TOP""|""MIDDLE""|""BOTTOM""]"
|
|
|
|
Check:
|
|
Set oControl = Nothing
|
|
If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally
|
|
|
|
If IsMissing(Border) Or IsEmpty(Border) Then Border = "NONE"
|
|
If IsMissing(MultiLine) Or IsEmpty(MultiLine) Then MultiLine = False
|
|
If IsMissing(Align) Or IsEmpty(Align) Then Align = "LEFT"
|
|
If IsMissing(VerticalAlign) Or IsEmpty(VerticalAlign) Then VerticalAlign = "TOP"
|
|
|
|
If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(MultiLine, "MultiLine", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Align, "Align", V_STRING, Array("LEFT", "CENTER", "RIGHT")) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(VerticalAlign, "VerticalAlign", V_STRING, Array("TOP", "MIDDLE", "BOTTOM")) Then GoTo Finally
|
|
|
|
Try:
|
|
' Manage specific properties
|
|
iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border)
|
|
iAlign = ScriptForge.SF_Array.IndexOf(Array("LEFT", "CENTER", "BOTTOM"), Align)
|
|
Select Case UCase(VerticalAlign)
|
|
Case "TOP" : iVerticalAlign = com.sun.star.style.VerticalAlignment.TOP
|
|
Case "MIDDLE" : iVerticalAlign = com.sun.star.style.VerticalAlignment.MIDDLE
|
|
Case "BOTTOM" : iVerticalAlign = com.sun.star.style.VerticalAlignment.BOTTOM
|
|
End Select
|
|
vPropNames = Array("Border", "MultiLine", "Align", "VerticalAlign")
|
|
vPropValues = Array(iBorder, CBool(MultiLine), iAlign, iVerticalAlign)
|
|
|
|
' Create the control
|
|
Set oControl = _CreateNewControl("UnoControlFixedTextModel", ControlName, Place, vPropNames, vPropValues)
|
|
|
|
Finally:
|
|
Set CreateFixedText = oControl
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
End Function ' SFDialogs.SF_Dialog.CreateFixedText
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function CreateFormattedField(Optional ByVal ControlName As Variant _
|
|
, Optional ByRef Place As Variant _
|
|
, Optional ByVal Border As Variant _
|
|
, Optional ByVal SpinButton As Variant _
|
|
, Optional ByVal MinValue As Variant _
|
|
, Optional ByVal MaxValue As Variant _
|
|
) As Object
|
|
''' Create a new control of type FormattedField in the actual dialog.
|
|
''' Specific args:
|
|
''' Border: "3D" (default) or "FLAT" or "NONE"
|
|
''' SpinButton:: when True (default = False), a spin button is present
|
|
''' MinValue: the smallest value that can be entered in the control. Default = -1000000
|
|
''' MaxValue: the largest value that can be entered in the control. Default = +1000000
|
|
''' Returns:
|
|
''' an instance of the SF_DialogControl class or Nothing
|
|
''' Example:
|
|
''' Set myFormattedField = dialog.CreateFormattedField("FormattedField1", Array(20, 20, 60, 15), SpinButton := True)
|
|
''' myFormattedField.Format = "##0,00E+00"
|
|
|
|
Dim oControl As Object ' Return value
|
|
Dim iBorder As Integer ' Alias of border
|
|
Dim vPropNames As Variant ' Array of names of specific arguments
|
|
Dim vPropValues As Variant ' Array of values of specific arguments
|
|
Const cstThisSub = "SFDialogs.Dialog.CreateFormattedField"
|
|
Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""], [SpinButton=False]" _
|
|
& ", [MinValue=-1000000], MaxValue=+1000000]"
|
|
|
|
Check:
|
|
Set oControl = Nothing
|
|
If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally
|
|
|
|
If IsMissing(Border) Or IsEmpty(Border) Then Border = "3D"
|
|
If IsMissing(SpinButton) Or IsEmpty(SpinButton) Then SpinButton = False
|
|
If IsMissing(MinValue) Or IsEmpty(MinValue) Then MinValue = -1000000.00
|
|
If IsMissing(MaxValue) Or IsEmpty(MaxValue) Then MaxValue = +1000000.00
|
|
|
|
If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(SpinButton, "SpinButton", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(MinValue, "MinValue", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(MaxValue, "MaxValue", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
|
|
Try:
|
|
' Manage specific properties
|
|
iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border)
|
|
vPropNames = Array("FormatsSupplier", "Border", "Spin", "EffectiveMin", "EffectiveMax")
|
|
vPropValues = Array(CreateUnoService("com.sun.star.util.NumberFormatsSupplier") _
|
|
, iBorder, CBool(SpinButton), CDbl(MinValue), CDbl(MaxValue))
|
|
|
|
' Create the control
|
|
Set oControl = _CreateNewControl("UnoControlFormattedFieldModel", ControlName, Place, vPropNames, vPropValues)
|
|
|
|
Finally:
|
|
Set CreateFormattedField = oControl
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDialogs.SF_Dialog.CreateFormattedField
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function CreateGroupBox(Optional ByVal ControlName As Variant _
|
|
, Optional ByRef Place As Variant _
|
|
) As Object
|
|
''' Create a new control of type GroupBox in the actual dialog.
|
|
''' Specific args:
|
|
''' Orientation: "H[orizontal]" or "V[ertical]"
|
|
''' Returns:
|
|
''' an instance of the SF_DialogControl class or Nothing
|
|
''' Example:
|
|
''' Set myGroupBox = dialog.CreateGroupBox("GroupBox1", Array(20, 20, 60, 15))
|
|
|
|
Dim oControl As Object ' Return value
|
|
Dim vPropNames As Variant ' Array of names of specific arguments
|
|
Dim vPropValues As Variant ' Array of values of specific arguments
|
|
Const cstThisSub = "SFDialogs.Dialog.CreateGroupBox"
|
|
Const cstSubArgs = "ControlName, Place"
|
|
|
|
Check:
|
|
Set oControl = Nothing
|
|
If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally
|
|
|
|
Try:
|
|
' Manage specific properties
|
|
vPropNames = Array()
|
|
vPropValues = Array()
|
|
|
|
' Create the control
|
|
Set oControl = _CreateNewControl("UnoControlGroupBoxModel", ControlName, Place, vPropNames, vPropValues)
|
|
|
|
Finally:
|
|
Set CreateGroupBox = oControl
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDialogs.SF_Dialog.CreateGroupBox
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function CreateHyperlink(Optional ByVal ControlName As Variant _
|
|
, Optional ByRef Place As Variant _
|
|
, Optional ByVal Border As Variant _
|
|
, Optional ByVal MultiLine As Variant _
|
|
, Optional ByVal Align As Variant _
|
|
, Optional ByVal VerticalAlign As Variant _
|
|
) As Object
|
|
''' Create a new control of type Hyperlink in the actual dialog.
|
|
''' Specific args:
|
|
''' Border: "NONE" (default) or "FLAT" or "3D"
|
|
''' MultiLine: When True (default = False), the caption may be displayed on more than one line
|
|
''' Align: horizontal alignment, "LEFT" (default) or "CENTER" or "RIGHT"
|
|
''' VerticalAlign: vertical alignment, "TOP" (default) or "MIDDLE" or "BOTTOM"
|
|
''' Returns:
|
|
''' an instance of the SF_DialogControl class or Nothing
|
|
''' Example:
|
|
''' Set myHyperlink = dialog.CreateHyperlink("Hyperlink1", Array(20, 20, 60, 15), MultiLine := True)
|
|
|
|
Dim oControl As Object ' Return value
|
|
Dim iBorder As Integer ' Alias of border
|
|
Dim iAlign As Integer ' Alias of Align
|
|
Dim iVerticalAlign As Integer ' Alias of VerticalAlign
|
|
Dim vPropNames As Variant ' Array of names of specific arguments
|
|
Dim vPropValues As Variant ' Array of values of specific arguments
|
|
Const cstThisSub = "SFDialogs.Dialog.CreateHyperlink"
|
|
Const cstSubArgs = "ControlName, Place, [MultiLine=False], [Border=""NONE""|""FLAT""|""3D""]" _
|
|
& ", [Align=""LEFT""|""CENTER""|""RIGHT""], [VerticalAlign=""TOP""|""MIDDLE""|""BOTTOM""]"
|
|
|
|
Check:
|
|
Set oControl = Nothing
|
|
If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally
|
|
|
|
If IsMissing(Border) Or IsEmpty(Border) Then Border = "NONE"
|
|
If IsMissing(MultiLine) Or IsEmpty(MultiLine) Then MultiLine = False
|
|
If IsMissing(Align) Or IsEmpty(Align) Then Align = "LEFT"
|
|
If IsMissing(VerticalAlign) Or IsEmpty(VerticalAlign) Then VerticalAlign = "TOP"
|
|
|
|
If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(MultiLine, "MultiLine", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Align, "Align", V_STRING, Array("LEFT", "CENTER", "RIGHT")) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(VerticalAlign, "VerticalAlign", V_STRING, Array("TOP", "MIDDLE", "BOTTOM")) Then GoTo Finally
|
|
|
|
Try:
|
|
' Manage specific properties
|
|
iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border)
|
|
iAlign = ScriptForge.SF_Array.IndexOf(Array("LEFT", "CENTER", "BOTTOM"), Align)
|
|
Select Case UCase(VerticalAlign)
|
|
Case "TOP" : iVerticalAlign = com.sun.star.style.VerticalAlignment.TOP
|
|
Case "MIDDLE" : iVerticalAlign = com.sun.star.style.VerticalAlignment.MIDDLE
|
|
Case "BOTTOM" : iVerticalAlign = com.sun.star.style.VerticalAlignment.BOTTOM
|
|
End Select
|
|
vPropNames = Array("Border", "MultiLine", "Align", "VerticalAlign")
|
|
vPropValues = Array(iBorder, CBool(MultiLine), iAlign, iVerticalAlign)
|
|
|
|
' Create the control
|
|
Set oControl = _CreateNewControl("UnoControlFixedHyperlinkModel", ControlName, Place, vPropNames, vPropValues)
|
|
|
|
Finally:
|
|
Set CreateHyperlink = oControl
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
End Function ' SFDialogs.SF_Dialog.CreateHyperlink
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function CreateImageControl(Optional ByVal ControlName As Variant _
|
|
, Optional ByRef Place As Variant _
|
|
, Optional ByVal Border As Variant _
|
|
, Optional ByVal Scale As Variant _
|
|
) As Object
|
|
''' Create a new control of type ImageControl in the actual dialog.
|
|
''' Specific args:
|
|
''' Border: "3D" (default) or "FLAT" or "NONE"
|
|
''' Scale: One of next values: "FITTOSIZE" (default), "KEEPRATIO" or "NO"
|
|
''' Returns:
|
|
''' an instance of the SF_DialogControl class or Nothing
|
|
''' Example:
|
|
''' Set myImageControl = dialog.CreateImageControl("ImageControl1", Array(20, 20, 60, 15))
|
|
|
|
Dim oControl As Object ' Return value
|
|
Dim iBorder As Integer ' Alias of border
|
|
Dim iScale As Integer ' Alias of Scale
|
|
Dim bScale As Boolean ' When False, no scaling
|
|
Dim vPropNames As Variant ' Array of names of specific arguments
|
|
Dim vPropValues As Variant ' Array of values of specific arguments
|
|
Const cstThisSub = "SFDialogs.Dialog.CreateImageControl"
|
|
Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""], [Scale=""FITTOSIZE""|""KEEPRATIO""|""NO""]"
|
|
|
|
Check:
|
|
Set oControl = Nothing
|
|
If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally
|
|
|
|
If IsMissing(Border) Or IsEmpty(Border) Then Border = "3D"
|
|
If IsMissing(Scale) Or IsEmpty(Scale) Then Scale = "FITTOSIZE"
|
|
If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Scale, "Scale", V_STRING, Array("FITTOSIZE", "KEEPRATIO", "NO")) Then GoTo Finally
|
|
|
|
Try:
|
|
' Manage specific properties
|
|
iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border)
|
|
Select Case UCase(Scale)
|
|
Case "NO" : iScale = com.sun.star.awt.ImageScaleMode.NONE : bScale = False
|
|
Case "FITTOSIZE" : iScale = com.sun.star.awt.ImageScaleMode.ANISOTROPIC : bScale = True
|
|
Case "KEEPRATIO" : iScale = com.sun.star.awt.ImageScaleMode.ISOTROPIC : bScale = True
|
|
End Select
|
|
vPropNames = Array("Border", "ScaleImage", "ScaleMode")
|
|
vPropValues = Array(iBorder, bScale, iScale)
|
|
|
|
' Create the control
|
|
Set oControl = _CreateNewControl("UnoControlImageControlModel", ControlName, Place, vPropNames, vPropValues)
|
|
|
|
Finally:
|
|
Set CreateImageControl = oControl
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDialogs.SF_Dialog.CreateImageControl
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function CreateListBox(Optional ByVal ControlName As Variant _
|
|
, Optional ByRef Place As Variant _
|
|
, Optional ByVal Border As Variant _
|
|
, Optional ByVal Dropdown As Variant _
|
|
, Optional ByVal LineCount As Variant _
|
|
, Optional ByVal MultiSelect As Variant _
|
|
) As Object
|
|
''' Create a new control of type ListBox in the actual dialog.
|
|
''' Specific args:
|
|
''' Border: "3D" (default) or "FLAT" or "NONE"
|
|
''' Dropdown: When True (default), a drop down button is displayed
|
|
''' LineCount: Specifies the maximum line count displayed in the drop down (default = 5)
|
|
''' MultiSelect: When True, more than 1 entry may be selected. Default = False
|
|
''' Returns:
|
|
''' an instance of the SF_DialogControl class or Nothing
|
|
''' Example:
|
|
''' Set myListBox = dialog.CreateListBox("ListBox1", Array(20, 20, 60, 15), Dropdown := True, MultiSelect := True)
|
|
|
|
Dim oControl As Object ' Return value
|
|
Dim iBorder As Integer ' Alias of border
|
|
Dim vPropNames As Variant ' Array of names of specific arguments
|
|
Dim vPropValues As Variant ' Array of values of specific arguments
|
|
Const cstThisSub = "SFDialogs.Dialog.CreateListBox"
|
|
Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""], [Dropdown=True], [LineCount=5], [MultiSelect=False]"
|
|
|
|
Check:
|
|
Set oControl = Nothing
|
|
If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally
|
|
|
|
If IsMissing(Border) Or IsEmpty(Border) Then Border = "3D"
|
|
If IsMissing(Dropdown) Or IsEmpty(Dropdown) Then Dropdown = True
|
|
If IsMissing(LineCount) Or IsEmpty(LineCount) Then LineCount = 5
|
|
If IsMissing(MultiSelect) Or IsEmpty(MultiSelect) Then MultiSelect = True
|
|
|
|
If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Dropdown, "Dropdown", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(LineCount, "LineCount", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(MultiSelect, "MultiSelect", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
|
|
Try:
|
|
' Manage specific properties
|
|
iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border)
|
|
vPropNames = Array("Border", "Dropdown", "LineCount", "MultiSelection")
|
|
vPropValues = Array(iBorder, CBool(Dropdown), CInt(LineCount), CBool(MultiSelect))
|
|
|
|
' Create the control
|
|
Set oControl = _CreateNewControl("UnoControlListBoxModel", ControlName, Place, vPropNames, vPropValues)
|
|
|
|
Finally:
|
|
Set CreateListBox = oControl
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
End Function ' SFDialogs.SF_Dialog.CreateListBox
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function CreateNumericField(Optional ByVal ControlName As Variant _
|
|
, Optional ByRef Place As Variant _
|
|
, Optional ByVal Border As Variant _
|
|
, Optional ByVal SpinButton As Variant _
|
|
, Optional ByVal MinValue As Variant _
|
|
, Optional ByVal MaxValue As Variant _
|
|
, Optional ByVal Increment As Variant _
|
|
, Optional ByVal Accuracy As Variant _
|
|
) As Object
|
|
''' Create a new control of type NumericField in the actual dialog.
|
|
''' Specific args:
|
|
''' Border: "3D" (default) or "FLAT" or "NONE"
|
|
''' SpinButton:: when True (default = False), a spin button is present
|
|
''' MinValue: the smallest value that can be entered in the control. Default = -1000000
|
|
''' MaxValue: the largest value that can be entered in the control. Default = +1000000
|
|
''' Increment: the step when the spin button is pressed. Default = 1
|
|
''' Accuracy: specifies the decimal accuracy. Default = 2 decimal digits
|
|
''' Returns:
|
|
''' an instance of the SF_DialogControl class or Nothing
|
|
''' Example:
|
|
''' Set myNumericField = dialog.CreateNumericField("NumericField1", Array(20, 20, 60, 15), SpinButton := True)
|
|
|
|
Dim oControl As Object ' Return value
|
|
Dim iBorder As Integer ' Alias of border
|
|
Dim vPropNames As Variant ' Array of names of specific arguments
|
|
Dim vPropValues As Variant ' Array of values of specific arguments
|
|
Const cstThisSub = "SFDialogs.Dialog.CreateNumericField"
|
|
Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""], [SpinButton=False]" _
|
|
& ", [MinValue=-1000000], MaxValue=+1000000], [Increment=1], [Accuracy=2]"
|
|
|
|
Check:
|
|
Set oControl = Nothing
|
|
If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally
|
|
|
|
If IsMissing(Border) Or IsEmpty(Border) Then Border = "3D"
|
|
If IsMissing(SpinButton) Or IsEmpty(SpinButton) Then SpinButton = False
|
|
If IsMissing(MinValue) Or IsEmpty(MinValue) Then MinValue = -1000000.00
|
|
If IsMissing(MaxValue) Or IsEmpty(MaxValue) Then MaxValue = +1000000.00
|
|
If IsMissing(Increment) Or IsEmpty(Increment) Then Increment = 1.00
|
|
If IsMissing(Accuracy) Or IsEmpty(Accuracy) Then Accuracy = 2
|
|
|
|
If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(SpinButton, "SpinButton", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(MinValue, "MinValue", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(MaxValue, "MaxValue", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Increment, "Increment", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Accuracy, "Accuracy", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
|
|
Try:
|
|
' Manage specific properties
|
|
iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border)
|
|
vPropNames = Array("Border", "Spin", "ValueMin", "ValueMax", "ValueStep", "DecimalAccuracy")
|
|
vPropValues = Array(iBorder, CBool(SpinButton), CDbl(MinValue), CDbl(MaxValue), CDbl(Increment), CInt(Accuracy))
|
|
|
|
' Create the control
|
|
Set oControl = _CreateNewControl("UnoControlNumericFieldModel", ControlName, Place, vPropNames, vPropValues)
|
|
|
|
Finally:
|
|
Set CreateNumericField = oControl
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
End Function ' SFDialogs.SF_Dialog.CreateNumericField
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function CreatePatternField(Optional ByVal ControlName As Variant _
|
|
, Optional ByRef Place As Variant _
|
|
, Optional ByVal Border As Variant _
|
|
, Optional ByVal EditMask As Variant _
|
|
, Optional ByVal LiteralMask As Variant _
|
|
) As Object
|
|
''' Create a new control of type PatternField in the actual dialog.
|
|
''' Specific args:
|
|
''' Border: "3D" (default) or "FLAT" or "NONE"
|
|
''' Editmask: a character code that determines what the user may enter
|
|
''' LiteralMask: contains the initial values that are displayed in the pattern field
|
|
''' More details on https://wiki.documentfoundation.org/Documentation/DevGuide/Graphical_User_Interfaces#Pattern_Field
|
|
''' Returns:
|
|
''' an instance of the SF_DialogControl class or Nothing
|
|
''' Example:
|
|
''' Set myPatternField = dialog.CreatePatternField("PatternField1", Array(20, 20, 60, 15), EditMask := "NNLNNLLLLL", LiteralMask := "__.__.2002")
|
|
|
|
Dim oControl As Object ' Return value
|
|
Dim iBorder As Integer ' Alias of border
|
|
Dim vPropNames As Variant ' Array of names of specific arguments
|
|
Dim vPropValues As Variant ' Array of values of specific arguments
|
|
Const cstThisSub = "SFDialogs.Dialog.CreatePatternField"
|
|
Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""], [EditMask=""""], [LiteralMask=""""]"
|
|
|
|
Check:
|
|
Set oControl = Nothing
|
|
If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally
|
|
|
|
If IsMissing(Border) Or IsEmpty(Border) Then Border = "3D"
|
|
If IsMissing(EditMask) Or IsEmpty(EditMask) Then EditMask = ""
|
|
If IsMissing(LiteralMask) Or IsEmpty(LiteralMask) Then LiteralMask = ""
|
|
|
|
If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(EditMask, "EditMask", V_STRING) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(LiteralMask, "LiteralMask", V_STRING) Then GoTo Finally
|
|
|
|
Try:
|
|
' Manage specific properties
|
|
iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border)
|
|
vPropNames = Array("Border", "EditMask", "LiteralMask")
|
|
vPropValues = Array(iBorder, EditMask, LiteralMask)
|
|
|
|
' Create the control
|
|
Set oControl = _CreateNewControl("UnoControlPatternFieldModel", ControlName, Place, vPropNames, vPropValues)
|
|
|
|
Finally:
|
|
Set CreatePatternField = oControl
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDialogs.SF_Dialog.CreatePatternField
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function CreateProgressBar(Optional ByVal ControlName As Variant _
|
|
, Optional ByRef Place As Variant _
|
|
, Optional ByVal Border As Variant _
|
|
, Optional ByVal MinValue As Variant _
|
|
, Optional ByVal MaxValue As Variant _
|
|
) As Object
|
|
''' Create a new control of type ProgressBar in the actual dialog.
|
|
''' Specific args:
|
|
''' Border: "3D" (default) or "FLAT" or "NONE"
|
|
''' MinValue: the smallest value that can be entered in the control. Default = 0
|
|
''' MaxValue: the largest value that can be entered in the control. Default = 100
|
|
''' Returns:
|
|
''' an instance of the SF_DialogControl class or Nothing
|
|
''' Example:
|
|
''' Set myProgressBar = dialog.CreateProgressBar("ProgressBar1", Array(20, 20, 60, 15), MaxValue := 1000)
|
|
|
|
Dim oControl As Object ' Return value
|
|
Dim iBorder As Integer ' Alias of border
|
|
Dim vPropNames As Variant ' Array of names of specific arguments
|
|
Dim vPropValues As Variant ' Array of values of specific arguments
|
|
Const cstThisSub = "SFDialogs.Dialog.CreateProgressBar"
|
|
Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""], [MinValue=0], MaxValue=100]"
|
|
|
|
Check:
|
|
Set oControl = Nothing
|
|
If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally
|
|
|
|
If IsMissing(Border) Or IsEmpty(Border) Then Border = "3D"
|
|
If IsMissing(MinValue) Or IsEmpty(MinValue) Then MinValue = 0
|
|
If IsMissing(MaxValue) Or IsEmpty(MaxValue) Then MaxValue = 100
|
|
|
|
If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(MinValue, "MinValue", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(MaxValue, "MaxValue", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
|
|
Try:
|
|
' Manage specific properties
|
|
iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border)
|
|
vPropNames = Array("Border", "ProgressValueMin", "ProgressValueMax")
|
|
vPropValues = Array(iBorder, CLng(MinValue), CLng(MaxValue))
|
|
|
|
' Create the control
|
|
Set oControl = _CreateNewControl("UnoControlProgressBarModel", ControlName, Place, vPropNames, vPropValues)
|
|
|
|
Finally:
|
|
Set CreateProgressBar = oControl
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
End Function ' SFDialogs.SF_Dialog.CreateProgressBar
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function CreateRadioButton(Optional ByVal ControlName As Variant _
|
|
, Optional ByRef Place As Variant _
|
|
, Optional ByVal MultiLine As Variant _
|
|
) As Object
|
|
''' Create a new control of type RadioButton in the actual dialog.
|
|
''' Specific args:
|
|
''' MultiLine: When True (default = False), the caption may be displayed on more than one line
|
|
''' Returns:
|
|
''' an instance of the SF_DialogControl class or Nothing
|
|
''' Example:
|
|
''' Set myRadioButton = dialog.CreateRadioButton("RadioButton1", Array(20, 20, 60, 15), MultiLine := True)
|
|
|
|
Dim oControl As Object ' Return value
|
|
Dim vPropNames As Variant ' Array of names of specific arguments
|
|
Dim vPropValues As Variant ' Array of values of specific arguments
|
|
Const cstThisSub = "SFDialogs.Dialog.CreateRadioButton"
|
|
Const cstSubArgs = "ControlName, Place, [MultiLine=False]"
|
|
|
|
Check:
|
|
Set oControl = Nothing
|
|
If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally
|
|
|
|
If IsMissing(MultiLine) Or IsEmpty(MultiLine) Then MultiLine = False
|
|
If Not ScriptForge.SF_Utils._Validate(MultiLine, "MultiLine", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
|
|
Try:
|
|
' Manage specific properties
|
|
vPropNames = Array("VisualEffect", "MultiLine")
|
|
vPropValues = Array(1, CBool(MultiLine))
|
|
|
|
' Create the control
|
|
Set oControl = _CreateNewControl("UnoControlRadioButtonModel", ControlName, Place, vPropNames, vPropValues)
|
|
|
|
Finally:
|
|
Set CreateRadioButton = oControl
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
End Function ' SFDialogs.SF_Dialog.CreateRadioButton
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function CreateScrollBar(Optional ByVal ControlName As Variant _
|
|
, Optional ByRef Place As Variant _
|
|
, Optional ByVal Orientation As Variant _
|
|
, Optional ByVal Border As Variant _
|
|
, Optional ByVal MinValue As Variant _
|
|
, Optional ByVal MaxValue As Variant _
|
|
) As Object
|
|
''' Create a new control of type ScrollBar in the actual dialog.
|
|
''' Specific args:
|
|
''' Orientation: H[orizontal] or V[ertical]
|
|
''' Border: "3D" (default) or "FLAT" or "NONE"
|
|
''' MinValue: the smallest value that can be entered in the control. Default = 0
|
|
''' MaxValue: the largest value that can be entered in the control. Default = 100
|
|
''' Returns:
|
|
''' an instance of the SF_DialogControl class or Nothing
|
|
''' Example:
|
|
''' Set myScrollBar = dialog.CreateScrollBar("ScrollBar1", Array(20, 20, 60, 15), MaxValue := 1000)
|
|
|
|
Dim oControl As Object ' Return value
|
|
Dim iBorder As Integer ' Alias of border
|
|
Dim vPropNames As Variant ' Array of names of specific arguments
|
|
Dim vPropValues As Variant ' Array of values of specific arguments
|
|
Const cstThisSub = "SFDialogs.Dialog.CreateScrollBar"
|
|
Const cstSubArgs = "ControlName, Place, Orientation=""H""|""Horizontal""|""V""|""Vertical""" _
|
|
& ", [Border=""3D""|""FLAT""|""NONE""], [MinValue=0], MaxValue=100]"
|
|
|
|
Check:
|
|
Set oControl = Nothing
|
|
If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally
|
|
|
|
If IsMissing(Border) Or IsEmpty(Border) Then Border = "3D"
|
|
If IsMissing(MinValue) Or IsEmpty(MinValue) Then MinValue = 0
|
|
If IsMissing(MaxValue) Or IsEmpty(MaxValue) Then MaxValue = 100
|
|
|
|
If Not ScriptForge.SF_Utils._Validate(Orientation, "Orientation", V_STRING, Array("H", "Horizontal", "V", "Vertical")) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(MinValue, "MinValue", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(MaxValue, "MaxValue", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
|
|
Try:
|
|
' Manage specific properties
|
|
iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border)
|
|
vPropNames = Array("Border", "Orientation", "ScrollValueMin", "ScrollValueMax")
|
|
vPropValues = Array(iBorder, CLng(Iif(Left(UCase(Orientation), 1) = "V", 1, 0)), CLng(MinValue), CLng(MaxValue))
|
|
|
|
' Create the control
|
|
Set oControl = _CreateNewControl("UnoControlScrollBarModel", ControlName, Place, vPropNames, vPropValues)
|
|
|
|
Finally:
|
|
Set CreateScrollBar = oControl
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
End Function ' SFDialogs.SF_Dialog.CreateScrollBar
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function CreateTableControl(Optional ByVal ControlName As Variant _
|
|
, Optional ByRef Place As Variant _
|
|
, Optional ByVal Border As Variant _
|
|
, Optional ByVal RowHeaders As Variant _
|
|
, Optional ByVal ColumnHeaders As Variant _
|
|
, Optional ByVal ScrollBars As Variant _
|
|
, Optional ByVal GridLines As Variant _
|
|
) As Object
|
|
''' Create a new control of type TableControl in the actual dialog.
|
|
''' To fill the table with data, use the SetTableData() method
|
|
''' Specific args:
|
|
''' Border: "3D" (default) or "FLAT" or "NONE"
|
|
''' RowHeaders: when True (default), the row headers are shown
|
|
''' ColumnHeaders: when True (default), the column headers are shown
|
|
''' ScrollBars: H[orizontal] or V[ertical] or B[oth] or N[one] (default)
|
|
''' Note that scrollbars always appear dynamically when they are needed
|
|
''' GridLines: when True (default = False) horizontal and vertical lines are painted between the grid cells
|
|
''' Returns:
|
|
''' an instance of the SF_DialogControl class or Nothing
|
|
''' Example:
|
|
''' Set myTableControl = dialog.CreateTableControl("TableControl1", Array(20, 20, 60, 15), ScrollBars := "B")
|
|
|
|
Dim oControl As Object ' Return value
|
|
Dim iBorder As Integer ' Alias of border
|
|
Dim vPropNames As Variant ' Array of names of specific arguments
|
|
Dim vPropValues As Variant ' Array of values of specific arguments
|
|
Const cstThisSub = "SFDialogs.Dialog.CreateTableControl"
|
|
Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""], [RowHeaders=True], [ColumnHeaders=True]" _
|
|
& ", [ScrollBars=""N""|""None""|""B""|""Both""|""H""|""Horizontal""|""V""|""Vertical"""
|
|
|
|
Check:
|
|
Set oControl = Nothing
|
|
If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally
|
|
|
|
If IsMissing(Border) Or IsEmpty(Border) Then Border = "3D"
|
|
If IsMissing(RowHeaders) Or IsEmpty(RowHeaders) Then RowHeaders = True
|
|
If IsMissing(ColumnHeaders) Or IsEmpty(ColumnHeaders) Then ColumnHeaders = True
|
|
If IsMissing(ScrollBars) Or IsEmpty(ScrollBars) Then ScrollBars = "None"
|
|
If IsMissing(GridLines) Or IsEmpty(GridLines) Then GridLines = False
|
|
|
|
If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(RowHeaders, "RowHeaders", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(ColumnHeaders, "ColumnHeaders", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(ScrollBars, "ScrollBars", V_STRING, Array("N", "None", "B", "Both", "H", "Horizontal", "V", "Vertical")) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(GridLines, "GridLines", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
|
|
Try:
|
|
' Manage specific properties
|
|
iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border)
|
|
vPropNames = Array("Border", "ShowRowHeader", "ShowColumnHeader", "VScroll", "HScroll", "UseGridLines")
|
|
vPropValues = Array(iBorder, CBool(RowHeaders), CBool(ColumnHeaders) _
|
|
, Left(ScrollBars, 1) = "B" Or Left(ScrollBars, 1) = "V" _
|
|
, Left(ScrollBars, 1) = "B" Or Left(ScrollBars, 1) = "H" _
|
|
, CBool(GridLines) _
|
|
)
|
|
|
|
' Create the control
|
|
Set oControl = _CreateNewControl("grid.UnoControlGridModel", ControlName, Place, vPropNames, vPropValues)
|
|
|
|
Finally:
|
|
Set CreateTableControl = oControl
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
End Function ' SFDialogs.SF_Dialog.CreateTableControl
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function CreateTextField(Optional ByVal ControlName As Variant _
|
|
, Optional ByRef Place As Variant _
|
|
, Optional ByVal Border As Variant _
|
|
, Optional ByVal MultiLine As Variant _
|
|
, Optional ByVal MaximumLength As Variant _
|
|
, Optional ByVal PasswordCharacter As Variant _
|
|
) As Object
|
|
''' Create a new control of type TextField in the actual dialog.
|
|
''' Specific args:
|
|
''' Border: "3D" (default) or "FLAT" or "NONE"
|
|
''' MultiLine: When True (default = False), the caption may be displayed on more than one line
|
|
''' MaximumLength: the maximum character count (default = 0 meaning unlimited)
|
|
''' PasswordCharacter: a single character specifying the echo for a password text field (default = "")
|
|
''' MultiLine must be False to have PasswordCharacter being applied
|
|
''' Returns:
|
|
''' an instance of the SF_DialogControl class or Nothing
|
|
''' Example:
|
|
''' Set myTextField = dialog.CreateTextField("TextField1", Array(20, 20, 120, 50), MultiLine := True)
|
|
|
|
Dim oControl As Object ' Return value
|
|
Dim iBorder As Integer ' Alias of border
|
|
Dim iPassword As Integer ' Integer alias of PasswordCharacter
|
|
Dim vPropNames As Variant ' Array of names of specific arguments
|
|
Dim vPropValues As Variant ' Array of values of specific arguments
|
|
Const cstThisSub = "SFDialogs.Dialog.CreateTextField"
|
|
Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""], [MultiLine=False], [MaximumLength=0, [PasswordCharacter=""""]"
|
|
|
|
Check:
|
|
Set oControl = Nothing
|
|
If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally
|
|
|
|
If IsMissing(Border) Or IsEmpty(Border) Then Border = "3D"
|
|
If IsMissing(MultiLine) Or IsEmpty(MultiLine) Then MultiLine = False
|
|
If IsMissing(MaximumLength) Or IsEmpty(MaximumLength) Then MaximumLength = 0
|
|
If IsMissing(PasswordCharacter) Or IsEmpty(PasswordCharacter) Then PasswordCharacter = ""
|
|
|
|
If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(MultiLine, "MultiLine", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(MaximumLength, "MaximumLength", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(PasswordCharacter, "PasswordCharacter", V_STRING) Then GoTo Finally
|
|
|
|
' MultiLine has precedence over Password
|
|
If MultiLine Then PasswordCharacter = ""
|
|
|
|
Try:
|
|
' Manage specific properties
|
|
iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border)
|
|
If Len(PasswordCharacter) > 0 Then iPassword = Asc(Left(PasswordCharacter, 1)) Else iPassword = 0
|
|
vPropNames = Array("Border", "MultiLine", "MaxTextLen", "EchoChar", "AutoVScroll") ' AutoHScroll not implemented ??
|
|
vPropValues = Array(iBorder, CBool(MultiLine), CInt(MaximumLength), iPassword, True)
|
|
|
|
' Create the control
|
|
Set oControl = _CreateNewControl("UnoControlEditModel", ControlName, Place, vPropNames, vPropValues)
|
|
|
|
Finally:
|
|
Set CreateTextField = oControl
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
End Function ' SFDialogs.SF_Dialog.CreateTextField
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function CreateTimeField(Optional ByVal ControlName As Variant _
|
|
, Optional ByRef Place As Variant _
|
|
, Optional ByVal Border As Variant _
|
|
, Optional ByVal MinTime As Variant _
|
|
, Optional ByVal MaxTime As Variant _
|
|
) As Object
|
|
''' Create a new control of type TimeField in the actual dialog.
|
|
''' Specific args:
|
|
''' Border: "3D" (default) or "FLAT" or "NONE"
|
|
''' MinTime: the smallest time that can be entered in the control. Default = 0
|
|
''' MaxTime: the largest time that can be entered in the control. Default = 24h
|
|
''' Returns:
|
|
''' an instance of the SF_DialogControl class or Nothing
|
|
''' Example:
|
|
''' Set myTimeField = dialog.CreateTimeField("TimeField1", Array(20, 20, 60, 15))
|
|
|
|
Dim oControl As Object ' Return Time
|
|
Dim iBorder As Integer ' Alias of border
|
|
Dim oMinTime As New com.sun.star.util.Time
|
|
Dim oMaxTime As New com.sun.star.util.Time
|
|
Dim vFormats As Variant ' List of available time formats
|
|
Dim vPropNames As Variant ' Array of names of specific arguments
|
|
Dim vPropValues As Variant ' Array of values of specific arguments
|
|
Const cstThisSub = "SFDialogs.Dialog.CreateTimeField"
|
|
Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""]" _
|
|
& ", [MinTime=TimeSerial(0, 0, 0)], [MaxTime=TimeSerial(23, 59, 59)]"
|
|
|
|
Check:
|
|
Set oControl = Nothing
|
|
If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally
|
|
|
|
If IsMissing(Border) Or IsEmpty(Border) Then Border = "3D"
|
|
If IsMissing(MinTime) Or IsEmpty(MinTime) Then MinTime = TimeSerial(0, 0, 0)
|
|
If IsMissing(MaxTime) Or IsEmpty(MaxTime) Then MaxTime = TimeSerial(23, 59, 59)
|
|
|
|
If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._ValiDate(MinTime, "MinTime", ScriptForge.V_DATE) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._ValiDate(MaxTime, "MaxTime", ScriptForge.V_DATE) Then GoTo Finally
|
|
vFormats = SF_DialogUtils._FormatsList("TimeField")
|
|
|
|
Try:
|
|
' Manage specific properties
|
|
iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border)
|
|
With oMinTime
|
|
.Hours = Hour(MinTime) : .Minutes = Minute(MinTime) : .Seconds = Second(MinTime)
|
|
End With
|
|
With oMaxTime
|
|
.Hours = Hour(MaxTime) : .Minutes = Minute(MaxTime) : .Seconds = Second(MaxTime)
|
|
End With
|
|
vPropNames = Array("Border", "TimeMin", "TimeMax", "TimeFormat")
|
|
vPropValues = Array(iBorder, oMinTime, oMaxTime, CInt(ScriptForge.SF_Array.IndexOf(vFormats(), "24h short")))
|
|
|
|
' Create the control
|
|
Set oControl = _CreateNewControl("UnoControlTimeFieldModel", ControlName, Place, vPropNames, vPropValues)
|
|
|
|
Finally:
|
|
Set CreateTimeField = oControl
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
End Function ' SFDialogs.SF_Dialog.CreateTimeField
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function CreateTreeControl(Optional ByVal ControlName As Variant _
|
|
, Optional ByRef Place As Variant _
|
|
, Optional ByVal Border As Variant _
|
|
) As Object
|
|
''' Create a new control of type TreeControl in the actual dialog.
|
|
''' Specific args:
|
|
''' Border: "3D" (default) or "FLAT" or "NONE"
|
|
''' Returns:
|
|
''' an instance of the SF_DialogControl class or Nothing
|
|
''' Example:
|
|
''' Set myTreeControl = dialog.CreateTreeControl("TreeControl1", Array(20, 20, 60, 15))
|
|
|
|
Dim oControl As Object ' Return value
|
|
Dim iBorder As Integer ' Alias of border
|
|
Dim vPropNames As Variant ' Array of names of specific arguments
|
|
Dim vPropValues As Variant ' Array of values of specific arguments
|
|
Const cstThisSub = "SFDialogs.Dialog.CreateTreeControl"
|
|
Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""]"
|
|
|
|
Check:
|
|
Set oControl = Nothing
|
|
If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally
|
|
|
|
If IsMissing(Border) Or IsEmpty(Border) Then Border = "3D"
|
|
If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally
|
|
|
|
Try:
|
|
' Manage specific properties
|
|
iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border)
|
|
vPropNames = Array("Border", "SelectionType", "Editable", "ShowsHandles", "ShowsRootHandles")
|
|
vPropValues = Array(iBorder, com.sun.star.view.SelectionType.SINGLE, False, True, True)
|
|
|
|
' Create the control
|
|
Set oControl = _CreateNewControl("tree.TreeControlModel", ControlName, Place, vPropNames, vPropValues)
|
|
|
|
Finally:
|
|
Set CreateTreeControl = oControl
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDialogs.SF_Dialog.CreateTreeControl
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Sub EndExecute(Optional ByVal ReturnValue As Variant)
|
|
''' Ends the display of a modal dialog and gives back the argument
|
|
''' as return value for the current Execute() action
|
|
''' EndExecute is usually contained in the processing of a macro
|
|
''' triggered by a dialog or control event
|
|
''' Args:
|
|
''' ReturnValue: must be numeric. The value passed to the running Execute() method
|
|
''' Example:
|
|
''' Sub OnEvent(poEvent As Variant)
|
|
''' Dim oDlg As Object
|
|
''' Set oDlg = CreateScriptService("SFDialogs.DialogEvent", poEvent)
|
|
''' oDlg.EndExecute(25)
|
|
''' End Sub
|
|
|
|
Dim lExecute As Long ' Alias of ReturnValue
|
|
Const cstThisSub = "SFDialogs.Dialog.EndExecute"
|
|
Const cstSubArgs = "ReturnValue"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
|
|
Check:
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(ReturnValue, "ReturnValue", V_NUMERIC) Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
lExecute = CLng(ReturnValue)
|
|
Call _DialogControl.endDialog(lExecute)
|
|
|
|
Finally:
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Sub
|
|
Catch:
|
|
GoTo Finally
|
|
End Sub ' SFDialogs.SF_Dialog.EndExecute
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Execute(Optional ByVal Modal As Variant) As Long
|
|
''' Display the dialog and wait for its termination by the user
|
|
''' When the window Close button is clicked:
|
|
''' - a modal dialog is stopped as if a Cancel button was pressed
|
|
''' - a non-modal dialog is made hidden
|
|
''' Termination and disposal of the dialog instance are roles of user scripts
|
|
''' Args:
|
|
''' Modal: False when non-modal dialog. Default = True
|
|
''' Returns:
|
|
''' 0 = Cancel button pressed
|
|
''' 1 = OK button pressed
|
|
''' Otherwise: the dialog stopped with an EndExecute statement executed from a dialog or control event
|
|
''' Example:
|
|
''' Dim oDlg As Object, lReturn As Long
|
|
''' Set oDlg = CreateScriptService(,, "myDialog") ' Dialog stored in current document's standard library
|
|
''' lReturn = oDlg.Execute()
|
|
''' Select Case lReturn
|
|
|
|
Dim lExecute As Long ' Return value
|
|
Dim oListener As Object ' com.sun.star.awt.XTopWindowListener
|
|
Const cstThisSub = "SFDialogs.Dialog.Execute"
|
|
Const cstSubArgs = "[Modal=True]"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
lExecute = -1
|
|
|
|
Check:
|
|
If IsMissing(Modal) Or IsEmpty(Modal) Then Modal = True
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Modal, "Modal", V_BOOLEAN) Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
If Modal Then
|
|
_Modal = True
|
|
_Displayed = True
|
|
' In dynamic dialogs, injection of sizes and positions from model to view is done with setVisible()
|
|
_DialogControl.setVisible(True)
|
|
lExecute = _DialogControl.execute()
|
|
Select Case lExecute
|
|
Case 1 : lExecute = OKBUTTON
|
|
Case 0 : lExecute = CANCELBUTTON
|
|
Case Else
|
|
End Select
|
|
_Displayed = False
|
|
Else
|
|
_Modal = False
|
|
_Displayed = True
|
|
' To make visible an on-the-fly designed dialog when macro triggered from Python
|
|
_DialogModel.DesktopAsParent = Not ( _BuiltFromScratch And _BuiltInPython )
|
|
_DialogControl.setVisible(True)
|
|
' Watch the window Close button
|
|
Set oListener = CreateUnoListener("_SFNONMODAL_", "com.sun.star.awt.XTopWindowListener")
|
|
_DialogControl.addTopWindowListener(oListener)
|
|
lExecute = 0
|
|
End If
|
|
|
|
Finally:
|
|
Execute = lExecute
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
' When an error is caused by an event error, the location is unknown
|
|
SF_Exception.Raise(, "?")
|
|
GoTo Finally
|
|
End Function ' SFDialogs.SF_Dialog.Execute
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
|
|
''' Return the actual value of the given property
|
|
''' Args:
|
|
''' PropertyName: the name of the property as a string
|
|
''' Returns:
|
|
''' The actual value of the property
|
|
''' Exceptions:
|
|
''' ARGUMENTERROR The property does not exist
|
|
''' Examples:
|
|
''' oDlg.GetProperty("Caption")
|
|
|
|
Const cstThisSub = "SFDialogs.Dialog.GetProperty"
|
|
Const cstSubArgs = ""
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
GetProperty = Null
|
|
|
|
Check:
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
|
|
End If
|
|
|
|
Try:
|
|
GetProperty = _PropertyGet(PropertyName)
|
|
|
|
Finally:
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDialogs.SF_Dialog.GetProperty
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function GetTextsFromL10N(Optional ByRef L10N As Variant) As Boolean
|
|
''' Replace all fixed text strings of a dialog by their localized version
|
|
''' Replaced texts are:
|
|
''' - the title of the dialog
|
|
''' - the caption associated with next control types: Button, CheckBox, FixedLine, FixedText, GroupBox and RadioButton
|
|
''' - the content of list- and comboboxes
|
|
''' - the tip- or helptext displayed when the mouse is hovering the control
|
|
''' The current method has a twin method ScriptForge.SF_L10N.AddTextsFromDialog
|
|
''' The current method is probably run before the Execute() method
|
|
''' Args:
|
|
''' L10N : a "L10N" service instance created with CreateScriptService("L10N")
|
|
''' Returns:
|
|
''' True when successful
|
|
''' Examples:
|
|
''' Dim myPO As Object, oDlg As Object
|
|
''' Set oDlg = CreateScriptService("Dialog", "GlobalScope", "XrayTool", "DlgXray")
|
|
''' Set myPO = CreateScriptService("L10N", "C:\myPOFiles\", "fr-BE")
|
|
''' oDlg.GetTextsFromL10N(myPO)
|
|
|
|
Dim bGet As Boolean ' Return value
|
|
Dim vControls As Variant ' Array of control names
|
|
Dim sControl As String ' A single control name
|
|
Dim oControl As Object ' SFDialogs.DialogControl
|
|
Dim sText As String ' The text found in the dialog
|
|
Dim sTranslation As String ' The translated text got from the dictionary
|
|
Dim vSource As Variant ' RowSource property of dialog control as an array
|
|
Dim bChanged As Boolean ' True when at least 1 item of a RowSource is modified
|
|
Dim i As Long
|
|
|
|
Const cstThisSub = "SFDialogs.Dialog.GetTextsFromL10N"
|
|
Const cstSubArgs = "L10N"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bGet = False
|
|
|
|
Check:
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._Validate(L10N, "L10N", V_OBJECT, , , "L10N") Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
' Get the dialog title
|
|
sText = Caption
|
|
If Len(sText) > 0 Then
|
|
sTranslation = L10N._(sText)
|
|
If sText <> sTranslation Then Caption = sTranslation
|
|
End If
|
|
' Scan all controls
|
|
vControls = Controls()
|
|
For Each sControl In vControls
|
|
Set oControl = Controls(sControl)
|
|
With oControl
|
|
' Extract fixed texts
|
|
sText = .Caption
|
|
If Len(sText) > 0 Then
|
|
sTranslation = L10N._(sText)
|
|
If sText <> sTranslation Then .Caption = sTranslation
|
|
End If
|
|
vSource = .RowSource ' List and comboboxes only
|
|
If IsArray(vSource) Then
|
|
bChanged = False
|
|
For i = 0 To UBound(vSource)
|
|
If Len(vSource(i)) > 0 Then
|
|
sTranslation = L10N._(vSource(i))
|
|
If sTranslation <> vSource(i) Then
|
|
bChanged = True
|
|
vSource(i) = sTranslation
|
|
End If
|
|
End If
|
|
Next i
|
|
' Rewrite if at least 1 item has been modified by the translation process
|
|
If bChanged Then .RowSource = vSource
|
|
End If
|
|
sText = .TipText
|
|
If Len(sText) > 0 Then
|
|
sTranslation = L10N._(sText)
|
|
If sText <> sTranslation Then .TipText = sTranslation
|
|
End If
|
|
End With
|
|
Next sControl
|
|
|
|
bGet = True
|
|
|
|
Finally:
|
|
GetTextsFromL10N = bGet
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDialogs.SF_Dialog.GetTextsFromL10N
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Methods() As Variant
|
|
''' Return the list of public methods of the Model service as an array
|
|
|
|
Methods = Array( _
|
|
"Activate" _
|
|
, "Center" _
|
|
, "CloneControl" _
|
|
, "Controls" _
|
|
, "CreateButton" _
|
|
, "CreateCheckBox" _
|
|
, "CreateComboBox" _
|
|
, "CreateCurrencyField" _
|
|
, "CreateDateField" _
|
|
, "CreateFileControl" _
|
|
, "CreateFixedLine" _
|
|
, "CreateFixedText" _
|
|
, "CreateFormattedField" _
|
|
, "CreateGroupBox" _
|
|
, "CreateHyperlink" _
|
|
, "CreateImageControl" _
|
|
, "CreateListBox" _
|
|
, "CreateNumericField" _
|
|
, "CreatePatternField" _
|
|
, "CreateProgressBar" _
|
|
, "CreateRadioButton" _
|
|
, "CreateScrollBar" _
|
|
, "CreateTableControl" _
|
|
, "CreateTextField" _
|
|
, "CreateTimeField" _
|
|
, "CreateTreeControl" _
|
|
, "EndExecute" _
|
|
, "Execute" _
|
|
, "GetTextsFromL10N" _
|
|
, "OrderTabs" _
|
|
, "Resize" _
|
|
, "SetPageManager" _
|
|
, "Terminate" _
|
|
)
|
|
|
|
End Function ' SFDialogs.SF_Dialog.Methods
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function OrderTabs(ByRef Optional TabsList As Variant _
|
|
, ByVal Optional Start As Variant _
|
|
, ByVal Optional Increment As Variant _
|
|
) As Boolean
|
|
''' Set the tabulation index f a series of controls.
|
|
''' The sequence of controls are given as an array of control names from the first to the last.
|
|
''' Next controls will not be accessible (anymore ?) via the TAB key if >=1 of next conditions is met:
|
|
''' - if they are not in the given list
|
|
''' - if their type is FixedLine, GroupBox or ProgressBar
|
|
''' - if the control is disabled
|
|
''' Args:
|
|
''' TabsList: an array of valid control names in the order of tabulation
|
|
''' Start: the tab index to be assigned to the 1st control in the list. Default = 1
|
|
''' Increment: the difference between 2 successive tab indexes. Default = 1
|
|
''' Returns:
|
|
''' True when successful
|
|
''' Example:
|
|
''' dialog.OredrTabs(Array("myListBox", "myTextField", "myNumericField"), Start := 10)
|
|
|
|
Dim bOrder As Boolean ' Return value
|
|
Dim vControlNames As Variant ' List of control names in the dialog
|
|
Dim oControl As Object ' A SF_DialogControl instance
|
|
Dim bValid As Boolean ' When True, the considered control deserves a tab stop
|
|
Dim iTabIndex As Integer ' The tab index to be set
|
|
Dim vWrongTypes As Variant ' List of rejected control types
|
|
Dim i As Long
|
|
|
|
Const cstThisSub = "SFDialogs.Dialog.OrderTabs"
|
|
Const cstSubArgs = "TabsList, [Start=1], Încrement=1]"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bOrder = False
|
|
|
|
Check:
|
|
If IsMissing(Start) Or IsEmpty(Start) Then Start = 1
|
|
If IsMissing(Increment) Or IsEmpty(Increment) Then Increment = 1
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not ScriptForge.SF_Utils._ValidateArray(TabsList, "TabsList", 1, V_STRING, True) Then GoTo Finally
|
|
If Not SF_Utils._Validate(Start, "Start", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
If Not SF_Utils._Validate(Increment, "Increment", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
vWrongTypes = Array("FixedLine", "GroupBox", "ProgressBar")
|
|
|
|
' Remove all existing tabulations
|
|
vControlNames = _DialogModel.getElementNames()
|
|
For i = 0 To UBound(vControlNames)
|
|
Set oControl = Controls(vControlNames(i))
|
|
With oControl._ControlModel
|
|
If Not ScriptForge.SF_Array.Contains(vWrongTypes, oControl._ControlType) Then
|
|
.TabStop = False
|
|
.TabIndex = -1
|
|
End If
|
|
End With
|
|
Next i
|
|
|
|
iTabIndex = Start
|
|
|
|
' Go through the candidate controls for being tabulated and set tabs
|
|
For i = LBound(TabsList) To UBound(TabsList)
|
|
Set oControl = Controls(TabsList(i)) ' Error checking on input names happens here
|
|
With oControl._ControlModel
|
|
bValid = Not ScriptForge.SF_Array.Contains(vWrongTypes, oControl._ControlType)
|
|
If bValid Then bValid = .Enabled
|
|
If bValid Then
|
|
.TabStop = True
|
|
.TabIndex = iTabIndex
|
|
iTabIndex = iTabIndex + Increment
|
|
End If
|
|
End With
|
|
Next i
|
|
|
|
bOrder = True
|
|
|
|
Finally:
|
|
OrderTabs = bOrder
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDialogs.SF_Dialog.OrderTabls
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Properties() As Variant
|
|
''' Return the list or properties of the Dialog class as an array
|
|
|
|
Properties = Array( _
|
|
"Caption" _
|
|
, "Height" _
|
|
, "IsAlive" _
|
|
, "Modal" _
|
|
, "Name" _
|
|
, "OnFocusGained" _
|
|
, "OnFocusLost" _
|
|
, "OnKeyPressed" _
|
|
, "OnKeyReleased" _
|
|
, "OnMouseDragged" _
|
|
, "OnMouseEntered" _
|
|
, "OnMouseExited" _
|
|
, "OnMouseMoved" _
|
|
, "OnMousePressed" _
|
|
, "OnMouseReleased" _
|
|
, "Page" _
|
|
, "Visible" _
|
|
, "Width" _
|
|
, "XDialogModel" _
|
|
, "XDialogView" _
|
|
)
|
|
|
|
End Function ' SFDialogs.SF_Dialog.Properties
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Resize(Optional ByVal Left As Variant _
|
|
, Optional ByVal Top As Variant _
|
|
, Optional ByVal Width As Variant _
|
|
, Optional ByVal Height As Variant _
|
|
) As Boolean
|
|
''' Move the top-left corner of the dialog to new coordinates and/or modify its dimensions
|
|
''' Without arguments, the method resets the initial dimensions
|
|
''' Attributes denoting the position and size of a dialog are expressed in "Map AppFont" units.
|
|
''' Map AppFont units are device and resolution independent.
|
|
''' One Map AppFont unit is equal to one eighth of the average character (Systemfont) height and one quarter of the average character width.
|
|
''' The dialog editor (= the Basic IDE) also uses Map AppFont units.
|
|
''' Args:
|
|
''' Left : the horizontal distance from the top-left corner. It may be negative.
|
|
''' Top : the vertical distance from the top-left corner. It may be negative.
|
|
''' Width : the horizontal width of the rectangle containing the Dialog. It must be positive.
|
|
''' Height : the vertical height of the rectangle containing the Dialog. It must be positive.
|
|
''' Missing arguments are left unchanged.
|
|
''' Returns:
|
|
''' True when successful
|
|
''' Examples:
|
|
''' oDialog.Resize(100, 200, Height := 600) ' Width is not changed
|
|
|
|
Try:
|
|
Resize = SF_DialogUtils._Resize([Me], Left, Top, Width, Height)
|
|
|
|
End Function ' SFDialogss.SF_Dialog.Resize
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function SetPageManager(Optional ByVal PilotControls As Variant _
|
|
, Optional ByVal TabControls As Variant _
|
|
, Optional ByVal WizardControls As Variant _
|
|
, Optional ByVal LastPage As variant _
|
|
) As Boolean
|
|
''' Define how the dialog displays pages. The page manager is an alternative to the
|
|
''' direct use of the Page property of the dialog and dialogcontrol objects.
|
|
'''
|
|
''' 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.
|
|
'''
|
|
''' The arguments define which controls are involved in the orchestration of the displayed pages.
|
|
''' Possible options:
|
|
''' - select a value in a list- or combobox
|
|
''' - select an item in a group of radio buttons
|
|
''' - select a button linked to a page - placed side-by-side the buttons can simulate a tabbed interface
|
|
''' - press a NEXT or BACK button like in many wizards
|
|
''' Those options may be combined. The control updates will be synchronized.
|
|
''' The method will set the actual page number to 1. Afterwards the Page property may be used to display any other page
|
|
'''
|
|
''' The SetPageManager() method is to be run only once and before the Execute() statement.
|
|
''' If invoked several times, subsequent calls will be ignored.
|
|
''' The method will define new listeners on the concerned controls, addressing generic routines.
|
|
''' The corresponding events will be fired during the dialog execution.
|
|
''' Preset events (in the Basic IDE) will be preserved and executed immediately AFTER the page change.
|
|
''' The listeners will be removed at dialog termination.
|
|
'''
|
|
''' Args:
|
|
''' PilotControls: a comma-separated list of listbox, combobox or radiobutton controls
|
|
''' For radio buttons, provide the first in the group
|
|
''' TabControls: a comma-separated list of button controls in ascending order
|
|
''' WizardControls: a comma-separated list of 2 controls, a BACK button and a NEXT button
|
|
''' LastPage: the index of the last available page. Recommended when use of WizardControls
|
|
''' Returns:
|
|
''' True when successful
|
|
''' Examples:
|
|
''' dialog.SetPageManager(PilotControls := "aListBox,aComboBox") ' 2 controls may cause page changes
|
|
|
|
Dim bManager As Boolean ' Return value
|
|
Dim vControls As Variant ' Array of involved controls
|
|
Dim oControl As Object ' A DialogControl object
|
|
Dim i As Long
|
|
Const cstPrefix = "_SFTAB_" ' Prefix of Subs to trigger when involved controls are clicked
|
|
Const cstComma = ","
|
|
|
|
Const cstThisSub = "SFDialogs.Dialog.SetPageManager"
|
|
Const cstSubArgs = "[PilotControls=""""], [TabControls=""""], [WizardControls=""""]"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bManager = False
|
|
|
|
Check:
|
|
If IsMissing(PilotControls) Or IsEmpty(PilotControls) Then PilotControls = ""
|
|
If IsMissing(TabControls) Or IsEmpty(TabControls) Then TabControls = ""
|
|
If IsMissing(WizardControls) Or IsEmpty(WizardControls) Then WizardControls = ""
|
|
If IsMissing(LastPage) Or IsEmpty(LastPage) Then LastPage = 0
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not ScriptForge.SF_Utils._Validate(PilotControls, "PilotControls", V_STRING) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(TabControls, "TabControls", V_STRING) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(WizardControls, "WizardControls", V_STRING) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(LastPage, "LastPage", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
End If
|
|
' Ignore the call if already done before
|
|
If UBound(_PageManagement) >= 0 Then GoTo Finally
|
|
|
|
Try:
|
|
' Common listeners to all involved controls
|
|
Set _ItemListener = CreateUnoListener(cstPrefix, "com.sun.star.awt.XItemListener")
|
|
Set _ActionListener = CreateUnoListener(cstPrefix, "com.sun.star.awt.XActionListener")
|
|
|
|
' Register the arguments in the _PageManagement array, control by control
|
|
' Pilot controls
|
|
If Len(PilotControls) > 0 Then
|
|
vControls = Split(PilotControls, cstComma)
|
|
For i = 0 To UBound(vControls)
|
|
If Not _RegisterPageListener(Trim(vControls(i)), "ListBox,ComboBox,RadioButton", PILOTCONTROL, 0, ITEMSTATECHANGED) Then GoTo Catch
|
|
Next i
|
|
End If
|
|
' Tab controls
|
|
If Len(TabControls) > 0 Then
|
|
vControls = Split(TabControls, cstComma)
|
|
For i = 0 To UBound(vControls)
|
|
If Not _RegisterPageListener(Trim(vControls(i)), "Button", TABCONTROL, i + 1, ACTIONPERFORMED) Then GoTo Catch
|
|
Next i
|
|
End If
|
|
' Wizard controls
|
|
If Len(WizardControls) > 0 Then
|
|
vControls = Split(WizardControls, cstComma)
|
|
For i = 0 To UBound(vControls)
|
|
If Not _RegisterPageListener(Trim(vControls(i)), "Button", Iif(i = 0, BACKCONTROL, NEXTCONTROL), 0, ACTIONPERFORMED) Then GoTo Catch
|
|
Next i
|
|
End If
|
|
|
|
' Set the initial page to 1
|
|
Page = 1
|
|
_LastPage = LastPage
|
|
|
|
Finally:
|
|
SetPageManager = bManager
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
ScriptForge.SF_Exception.RaiseFatal(PAGEMANAGERERROR, "PilotControls", PilotControls, "TabControls", TabControls _
|
|
, "WizardControls", WizardControls)
|
|
GoTo Finally
|
|
End Function ' SFDialogs.SF_Dialog.SetPageManager
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function SetProperty(Optional ByVal PropertyName As Variant _
|
|
, Optional ByRef Value As Variant _
|
|
) As Boolean
|
|
''' Set a new value to the given property
|
|
''' Args:
|
|
''' PropertyName: the name of the property as a string
|
|
''' Value: its new value
|
|
''' Exceptions
|
|
''' ARGUMENTERROR The property does not exist
|
|
|
|
Const cstThisSub = "SFDialogs.Dialog.SetProperty"
|
|
Const cstSubArgs = "PropertyName, Value"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
SetProperty = False
|
|
|
|
Check:
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
|
|
End If
|
|
|
|
Try:
|
|
SetProperty = _PropertySet(PropertyName, Value)
|
|
|
|
Finally:
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDialogs.SF_Dialog.SetProperty
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Terminate() As Boolean
|
|
''' Terminate the dialog service for the current dialog instance
|
|
''' After termination any action on the current instance will be ignored
|
|
''' Args:
|
|
''' Returns:
|
|
''' True if termination is successful
|
|
''' Example:
|
|
''' Dim oDlg As Object, lReturn As Long
|
|
''' Set oDlg = CreateScriptService(,, "myDialog") ' Dialog stored in current document's standard library
|
|
''' lreturn = oDlg.Execute()
|
|
''' Select Case lReturn
|
|
''' ' ...
|
|
''' End Select
|
|
''' oDlg.Terminate()
|
|
|
|
Dim bTerminate As Boolean ' Return value
|
|
Const cstThisSub = "SFDialogs.Dialog.Terminate"
|
|
Const cstSubArgs = ""
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bTerminate = False
|
|
|
|
Check:
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
_RemoveAllListeners()
|
|
_DialogControl.dispose()
|
|
Set _DialogControl = Nothing
|
|
SF_Register._CleanCacheEntry(_CacheIndex)
|
|
_CacheIndex = -1
|
|
Dispose()
|
|
|
|
bTerminate = True
|
|
|
|
Finally:
|
|
Terminate = bTerminate
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDialogs.SF_Dialog.Terminate
|
|
|
|
REM =========================================================== PRIVATE FUNCTIONS
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _CheckNewControl(cstThisSub As String, cstSubArgs As String _
|
|
, Optional ByVal ControlName As Variant _
|
|
, ByRef Place As Variant _
|
|
) As Boolean
|
|
''' Check the generic arguments of a CreateXXX() method for control creation.
|
|
''' Called by the CreateButton, CreateCheckBox, ... specific methods
|
|
''' Args:
|
|
''' cstThisSub, cstSubArgs: caller routine and its arguments. Used to formulate an error message, if any.
|
|
''' ControlName: the name of the new control. It must not exist yet
|
|
''' Place: the size and position expressed in APPFONT units, either
|
|
''' - an array (X, Y, Width, Height) or Array(x, Y)
|
|
''' - a com.sun.star.awt.Rectangle structure
|
|
''' Exceptions:
|
|
''' DUPLICATECONTROLERROR A control with the same name exists already
|
|
''' Returns:
|
|
''' True when arguments passed the check
|
|
|
|
Dim bCheck As Boolean ' Return value
|
|
|
|
bCheck = False
|
|
|
|
Check:
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(ControlName, "ControlName", V_STRING) Then GoTo Finally
|
|
If IsArray(Place) Then
|
|
If Not ScriptForge.SF_Utils._ValidateArray(Place, "Place", 1, ScriptForge.V_NUMERIC, True) Then GoTo Finally
|
|
ElseIf Not IsNull(Place) Then
|
|
If Not ScriptForge.SF_Utils._Validate(Place, "Place", ScriptForge.V_OBJECT) Then GoTo Finally
|
|
End If
|
|
End If
|
|
If _DialogModel.hasByName(ControlName) Then GoTo CatchDuplicate
|
|
|
|
bCheck = True
|
|
|
|
Finally:
|
|
_CheckNewControl = bCheck
|
|
' Call to _ExitFunction is done in the caller to allow handling of specific arguments
|
|
Exit Function
|
|
CatchDuplicate:
|
|
ScriptForge.SF_Exception.RaiseFatal(DUPLICATECONTROLERROR, "ControlName", ControlName, _Name)
|
|
GoTo Finally
|
|
End Function ' SFDialogs.SF_Dialog._CheckNewControl
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _CreateNewControl(ByVal pvModel As Variant _
|
|
, ByVal ControlName As Variant _
|
|
, ByRef Place As Variant _
|
|
, Optional ByRef ArgNames As Variant _
|
|
, Optional ByRef ArgValues As Variant _
|
|
) As Object
|
|
''' Generic creation of a new control.
|
|
''' Called by the CreateButton, CreateCheckBox, ... specific methods
|
|
''' Args:
|
|
''' pvModel: one of the UnoControlxxx control models (as a string)
|
|
''' or such a model as a UNO class instance (cloned from an existing control)
|
|
''' ControlName: the name of the new control. It must not exist yet
|
|
''' Place: the size and position expressed in APPFONT units, either
|
|
''' - an array (X, Y, Width, Height)
|
|
''' - a com.sun.star.awt.Rectangle structure
|
|
''' ArgNames: the list of the specific arguments linked to the given pvModel
|
|
''' ArgValues: their values
|
|
''' Returns:
|
|
''' A new SF_DialogControl class instance or Nothing if creation failed
|
|
|
|
Dim oControl As Object ' Return value
|
|
Dim oControlModel As Object ' com.sun.star.awt.XControlModel
|
|
Dim vPlace As Variant ' Alias of Place when object to avoid "Object variable not set" error
|
|
Dim lCache As Long ' Number of elements in the controls cache
|
|
Static oSession As Object
|
|
|
|
Check:
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
Set oControl = Nothing
|
|
|
|
If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
|
|
|
|
If IsMissing(ArgNames) Or IsEmpty(ArgNames) Then ArgNames = Array()
|
|
If IsMissing(ArgValues) Or IsEmpty(ArgValues) Then ArgValues = Array()
|
|
|
|
Try:
|
|
' When the model is a string, create a new (empty) model instance
|
|
Select Case VarType(pvModel)
|
|
Case V_STRING : Set oControlModel = _DialogModel.createInstance("com.sun.star.awt." & pvModel)
|
|
Case ScriptForge.V_OBJECT : Set oControlModel = pvModel
|
|
End Select
|
|
|
|
oControlModel.Name = ControlName
|
|
|
|
' Set dimension and position
|
|
With oControlModel
|
|
If IsArray(Place) Then
|
|
' Ignore width and height when new control is cloned from an existing one
|
|
If UBound(Place) >= 1 Then
|
|
.PositionX = Place(0)
|
|
.PositionY = Place(1)
|
|
End If
|
|
If UBound(Place) >= 3 Then
|
|
.Width = Place(2)
|
|
.Height = Place(3)
|
|
End If
|
|
ElseIf oSession.UnoObjectType(Place) = "com.sun.star.awt.Rectangle" Then
|
|
Set vPlace = Place
|
|
.PositionX = vPlace.X
|
|
.PositionY = vPlace.Y
|
|
.Width = vPlace.Width
|
|
.Height = vPlace.Height
|
|
Else
|
|
'Leave everything to zero
|
|
End If
|
|
End With
|
|
|
|
' Store the specific properties in the model
|
|
If UBound(ArgNames) >= 0 Then oControlModel.setPropertyValues(ArgNames, ArgValues)
|
|
|
|
' Insert the new completed control model in the dialog
|
|
_DialogModel.insertByName(ControlName, oControlModel)
|
|
|
|
' Update controls cache - existing cache is presumed unchanged: new control is added at the end of Model.ElementNames
|
|
lCache = UBound(_ControlCache)
|
|
If lCache < 0 Then
|
|
ReDim _ControlCache(0 To 0)
|
|
Else
|
|
ReDim Preserve _ControlCache(0 To lCache + 1)
|
|
End If
|
|
|
|
' Now the UNO control exists, build the SF_DialogControl instance as usual
|
|
Set oControl = Controls(ControlName)
|
|
|
|
Finally:
|
|
Set _CreateNewControl = oControl
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDialogs.SF_Dialog._CreateNewControl
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _FindRadioSiblings(ByVal psRadioButton As String) As String
|
|
''' Given the name of the first radio button of a group, return all the names of the group
|
|
''' For dialogs, radio buttons are considered of the same group
|
|
''' when their tab indexes are contiguous.
|
|
''' Args:
|
|
''' psRadioButton: the exact name of the 1st radio button of the group
|
|
''' Returns:
|
|
''' A comma-separated list of the names of the 1st and the next radio buttons
|
|
''' belonging to the same group in their tabindex order.
|
|
''' The input argument when not a radio button
|
|
|
|
|
|
Dim sList As String ' Return value
|
|
Dim oRadioControl As Object ' DialogControl instance corresponding with the argument
|
|
Dim oControl As Object ' DialogControl instance
|
|
Dim vRadioList As Variant ' Array of all radio buttons having a tab index > tab index of argument
|
|
' 1st column = name of radio button, 2nd = its tab index
|
|
Dim iRadioTabIndex As Integer ' Tab index of the argument
|
|
Dim iTabIndex As Integer ' Any tab index
|
|
Dim vControlNames As Variant ' Array of control names
|
|
Dim sControlName As String ' A single item in vControlNames()
|
|
Dim i As Long
|
|
Const cstComma = ","
|
|
|
|
Check:
|
|
On Local Error GoTo Catch
|
|
sList = psRadioButton
|
|
vRadioList = Array()
|
|
|
|
Try:
|
|
Set oRadioControl = Controls(psRadioButton)
|
|
If oRadioControl.ControlType <> "RadioButton" Then GoTo Finally
|
|
iRadioTabIndex = oRadioControl._ControlModel.Tabindex
|
|
vRadioList = ScriptForge.SF_Array.AppendRow(vRadioList, Array(psRadioButton, iRadioTabIndex))
|
|
|
|
' Scan all controls. Store radio buttons having tab index > 1st radio button
|
|
vControlNames = Controls()
|
|
For Each sControlName In vControlNames
|
|
Set oControl = Controls(sControlName)
|
|
With oControl
|
|
If .Name <> psRadioButton Then
|
|
If .ControlType = "RadioButton" Then
|
|
iTabIndex = ._ControlModel.Tabindex
|
|
If iTabIndex > iRadioTabIndex Then
|
|
vRadioList = ScriptForge.SF_Array.AppendRow(vRadioList, Array(.Name, iTabIndex))
|
|
End If
|
|
End If
|
|
End If
|
|
End With
|
|
Next sControlName
|
|
|
|
vRadioList = ScriptForge.SF_Array.SortRows(vRadioList, 1)
|
|
' Retain contiguous tab indexes
|
|
For i = 1 To UBound(vRadioList, 1) ' First row = argument
|
|
If vRadioList(i, 1) = iRadioTabIndex + i Then sList = sList & cstComma & vRadioList(i, 0)
|
|
Next i
|
|
|
|
Finally:
|
|
_FindRadioSiblings = sList
|
|
Exit Function
|
|
Catch:
|
|
sList = psRadioButton
|
|
GoTo Finally
|
|
End Function ' SFDialogs.SF_Dialog._FindRadioSiblings
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function _GetEventName(ByVal psProperty As String) As String
|
|
''' Return the LO internal event name derived from the SF property name
|
|
''' The SF property name is not case sensitive, while the LO name is case-sensitive
|
|
' Corrects the typo on ErrorOccur(r?)ed, if necessary
|
|
|
|
Dim vProperties As Variant ' Array of class properties
|
|
Dim sProperty As String ' Correctly cased property name
|
|
|
|
vProperties = Properties()
|
|
sProperty = vProperties(ScriptForge.SF_Array.IndexOf(vProperties, psProperty, SortOrder := "ASC"))
|
|
|
|
_GetEventName = LCase(Mid(sProperty, 3, 1)) & Right(sProperty, Len(sProperty) - 3)
|
|
|
|
End Function ' SFDialogs.SF_Dialog._GetEventName
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _GetListener(ByVal psEventName As String) As String
|
|
''' Getting/Setting macros triggered by events requires a Listener-EventName pair
|
|
''' Return the X...Listener corresponding with the event name in argument
|
|
|
|
Select Case UCase(psEventName)
|
|
Case UCase("OnFocusGained"), UCase("OnFocusLost")
|
|
_GetListener = "XFocusListener"
|
|
Case UCase("OnKeyPressed"), UCase("OnKeyReleased")
|
|
_GetListener = "XKeyListener"
|
|
Case UCase("OnMouseDragged"), UCase("OnMouseMoved")
|
|
_GetListener = "XMouseMotionListener"
|
|
Case UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMousePressed"), UCase("OnMouseReleased")
|
|
_GetListener = "XMouseListener"
|
|
Case Else
|
|
_GetListener = ""
|
|
End Select
|
|
|
|
End Function ' SFDialogs.SF_Dialog._GetListener
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Sub _Initialize()
|
|
''' Complete the object creation process:
|
|
''' - Initialization of private members
|
|
''' - Creation of the dialog graphical interface
|
|
''' - Addition of the new object in the Dialogs buffer
|
|
''' - Initialisation of persistent storage for controls
|
|
|
|
Dim lControls As Long ' Number of controls at dialog creation
|
|
Try:
|
|
' Keep reference to model
|
|
Set _DialogModel = _DialogControl.Model
|
|
|
|
' Store initial position and dimensions
|
|
With _DialogModel
|
|
_Left = .PositionX
|
|
_Top = .PositionY
|
|
_Width = .Width
|
|
_Height = .Height
|
|
End With
|
|
|
|
' Add dialog reference to cache
|
|
_CacheIndex = SF_Register._AddDialogToCache(_DialogControl, [Me])
|
|
|
|
' Size the persistent storage
|
|
_ControlCache = Array()
|
|
lControls = UBound(_DialogModel.getElementNames())
|
|
If lControls >= 0 Then ReDim _ControlCache(0 To lControls)
|
|
|
|
Finally:
|
|
Exit Sub
|
|
End Sub ' SFDialogs.SF_Dialog._Initialize
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _IsStillAlive(Optional ByVal pbError As Boolean) As Boolean
|
|
''' Return True if the dialog service is still active
|
|
''' If dead the actual instance is disposed. The execution is cancelled when pbError = True (default)
|
|
''' Args:
|
|
''' pbError: if True (default), raise a fatal error
|
|
|
|
Dim bAlive As Boolean ' Return value
|
|
Dim sDialog As String ' Alias of DialogName
|
|
|
|
Check:
|
|
On Local Error GoTo Catch ' Anticipate DisposedException errors or alike
|
|
If IsMissing(pbError) Then pbError = True
|
|
|
|
Try:
|
|
bAlive = ( Not IsNull(_DialogProvider) Or _BuiltFromScratch )
|
|
If bAlive Then bAlive = Not IsNull(_DialogControl)
|
|
If Not bAlive Then GoTo Catch
|
|
|
|
Finally:
|
|
_IsStillAlive = bAlive
|
|
Exit Function
|
|
Catch:
|
|
bAlive = False
|
|
On Error GoTo 0
|
|
sDialog = _Name
|
|
Dispose()
|
|
If pbError Then ScriptForge.SF_Exception.RaiseFatal(DIALOGDEADERROR, sDialog)
|
|
GoTo Finally
|
|
End Function ' SFDialogs.SF_Dialog._IsStillAlive
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Sub _JumpToPage(ByVal plPage As Long)
|
|
''' Called when the Page property is set to a new value
|
|
''' The rules defined in the _pageManagement array are applied here
|
|
|
|
Dim oPageManager As Object ' A single entry in _PageManagement of type _PageManager
|
|
Dim oControl As Object ' DialogControl instance
|
|
Dim lPage As Long ' A dialog page number
|
|
|
|
Check:
|
|
On Local Error GoTo Finally
|
|
' ControlName As String ' Case-sensitive name of control involved in page management
|
|
' PageMgtType As Integer ' One of the PILOTCONTROL, TABCONTROL, BACKCONTROL, NEXTCONTROL constants
|
|
' PageNumber As Long ' When > 0, the page to activate for tab controls
|
|
' ListenerType As Integer ' One of the ITEMSTATECHANGED, ACTIONPERFORMED constants
|
|
|
|
If plPage <= 0 Or (_LastPage > 0 And plPage > _LastPage) Then Exit Sub
|
|
If UBound(_PageManagement) < 0 Then Exit Sub
|
|
|
|
Try:
|
|
' Controls listed in the array must be synchronized with the page #
|
|
' Listboxes and comboboxes must be set to the corresponding value
|
|
' The right radio button must be selected
|
|
' One corresponding button must be dimmed, other must be enabled
|
|
' The Next button must be dimmed when last page otherwise enabled
|
|
For Each oPageManager In _PageManagement
|
|
With oPageManager
|
|
lPage = .PageNumber
|
|
Set oControl = Controls(.ControlName)
|
|
With oControl
|
|
Select Case .ControlType
|
|
Case "ListBox", "ComboBox"
|
|
If plPage <= .ListCount Then .ListIndex = plPage - 1 ' ListIndex is zero-based
|
|
Case "RadioButton"
|
|
.Value = ( plPage = lPage )
|
|
Case "Button"
|
|
Select Case oPageManager.PageMgtType
|
|
Case TABCONTROL
|
|
.Value = ( plPage = lPage )
|
|
Case BACKCONTROL
|
|
.Enabled = ( plPage <> 1 )
|
|
Case NEXTCONTROL
|
|
.Enabled = ( _LastPage = 0 Or plPage < _LastPage )
|
|
Case Else
|
|
End Select
|
|
Case Else
|
|
End Select
|
|
End With
|
|
End With
|
|
Next oPageManager
|
|
|
|
Finally:
|
|
Exit Sub
|
|
End Sub ' SFDialogs.SF_Dialog._JumpToPage
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _PropertyGet(Optional ByVal psProperty As String) As Variant
|
|
''' Return the value of the named property
|
|
''' Args:
|
|
''' psProperty: the name of the property
|
|
|
|
Static oSession As Object ' Alias of SF_Session
|
|
Dim oPosSize As Object ' com.sun.star.awt.Rectangle
|
|
Dim oDialogEvents As Object ' com.sun.star.container.XNameContainer
|
|
Dim sEventName As String ' Internal event name
|
|
Dim cstThisSub As String
|
|
Const cstSubArgs = ""
|
|
|
|
cstThisSub = "SFDialogs.Dialog.get" & psProperty
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
|
|
ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
|
|
If UCase(psProperty) <> UCase("IsAlive") Then
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
End If
|
|
|
|
If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
|
|
Select Case UCase(psProperty)
|
|
Case UCase("Caption")
|
|
If oSession.HasUNOProperty(_DialogModel, "Title") Then _PropertyGet = _DialogModel.Title
|
|
Case UCase("Height")
|
|
If _Displayed Then ' Convert PosSize view property from pixels to APPFONT units
|
|
_PropertyGet = SF_DialogUtils._ConvertToAppFont(_DialogControl, False).Height
|
|
Else
|
|
If oSession.HasUNOProperty(_DialogModel, "Height") Then _PropertyGet = _DialogModel.Height
|
|
End If
|
|
Case UCase("IsAlive")
|
|
_PropertyGet = _IsStillAlive(False)
|
|
Case UCase("Modal")
|
|
_PropertyGet = _Modal
|
|
Case UCase("Name")
|
|
_PropertyGet = _Name
|
|
Case UCase("OnFocusGained"), UCase("OnFocusLost"), UCase("OnKeyPressed"), UCase("OnKeyReleased") _
|
|
, UCase("OnMouseDragged"), UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMouseMoved") _
|
|
, UCase("OnMousePressed"), UCase("OnMouseReleased")
|
|
' Check OnEvents set statically in Basic IDE
|
|
Set oDialogEvents = _DialogModel.getEvents()
|
|
sEventName = "com.sun.star.awt." & _GetListener(psProperty) & "::" & _GetEventName(psProperty)
|
|
If oDialogEvents.hasByName(sEventName) Then
|
|
_PropertyGet = oDialogEvents.getByName(sEventName).ScriptCode
|
|
Else
|
|
' Check OnEvents set dynamically by code
|
|
Select Case UCase(psProperty)
|
|
Case UCase("OnFocusGained") : _PropertyGet = _OnFocusGained
|
|
Case UCase("OnFocusLost") : _PropertyGet = _OnFocusLost
|
|
Case UCase("OnKeyPressed") : _PropertyGet = _OnKeyPressed
|
|
Case UCase("OnKeyReleased") : _PropertyGet = _OnKeyReleased
|
|
Case UCase("OnMouseDragged") : _PropertyGet = _OnMouseDragged
|
|
Case UCase("OnMouseEntered") : _PropertyGet = _OnMouseEntered
|
|
Case UCase("OnMouseExited") : _PropertyGet = _OnMouseExited
|
|
Case UCase("OnMouseMoved") : _PropertyGet = _OnMouseMoved
|
|
Case UCase("OnMousePressed") : _PropertyGet = _OnMousePressed
|
|
Case UCase("OnMouseReleased") : _PropertyGet = _OnMouseReleased
|
|
Case Else : _PropertyGet = ""
|
|
End Select
|
|
End If
|
|
Case UCase("Page")
|
|
If oSession.HasUNOProperty(_DialogModel, "Step") Then _PropertyGet = _DialogModel.Step
|
|
Case UCase("Visible")
|
|
If oSession.HasUnoMethod(_DialogControl, "isVisible") Then _PropertyGet = CBool(_DialogControl.isVisible())
|
|
Case UCase("Width")
|
|
If _Displayed Then ' Convert PosSize view property from pixels to APPFONT units
|
|
_PropertyGet = SF_DialogUtils._ConvertToAppFont(_DialogControl, False).Width
|
|
Else
|
|
If oSession.HasUNOProperty(_DialogModel, "Width") Then _PropertyGet = _DialogModel.Width
|
|
End If
|
|
Case UCase("XDialogModel")
|
|
Set _PropertyGet = _DialogModel
|
|
Case UCase("XDialogView")
|
|
Set _PropertyGet = _DialogControl
|
|
Case Else
|
|
_PropertyGet = Null
|
|
End Select
|
|
|
|
Finally:
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDialogs.SF_Dialog._PropertyGet
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _PropertySet(Optional ByVal psProperty As String _
|
|
, Optional ByVal pvValue As Variant _
|
|
) As Boolean
|
|
''' Set the new value of the named property
|
|
''' Args:
|
|
''' psProperty: the name of the property
|
|
''' pvValue: the new value of the given property
|
|
''' Returns:
|
|
''' True if successful
|
|
|
|
Dim bSet As Boolean ' Return value
|
|
Static oSession As Object ' Alias of SF_Session
|
|
Dim cstThisSub As String
|
|
Const cstSubArgs = "Value"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bSet = False
|
|
|
|
cstThisSub = "SFDialogs.Dialog.set" & psProperty
|
|
ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
|
|
If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
|
|
bSet = True
|
|
Select Case UCase(psProperty)
|
|
Case UCase("Caption")
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Caption", V_STRING) Then GoTo Catch
|
|
If oSession.HasUNOProperty(_DialogModel, "Title") Then _DialogModel.Title = pvValue
|
|
Case UCase("Height")
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Height", ScriptForge.V_NUMERIC) Then GoTo Catch
|
|
bSet = Resize(Height := pvValue)
|
|
Case UCase("OnFocusGained"), UCase("OnFocusLost"), UCase("OnKeyPressed"), UCase("OnKeyReleased") _
|
|
, UCase("OnMouseDragged"), UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMouseMoved") _
|
|
, UCase("OnMousePressed"), UCase("OnMouseReleased")
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, psProperty, V_STRING) Then GoTo Catch
|
|
bSet = SF_DialogListener._SetOnProperty([Me], psProperty, pvValue)
|
|
Case UCase("Page")
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Page", ScriptForge.V_NUMERIC) Then GoTo Catch
|
|
If oSession.HasUNOProperty(_DialogModel, "Step") Then
|
|
_DialogModel.Step = CLng(pvValue)
|
|
' Execute the page manager instructions
|
|
_JumpToPage(pvValue)
|
|
End If
|
|
Case UCase("Visible")
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Visible", ScriptForge.V_BOOLEAN) Then GoTo Catch
|
|
If oSession.HasUnoMethod(_DialogControl, "setVisible") Then _DialogControl.setVisible(pvValue)
|
|
Case UCase("Width")
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Width", ScriptForge.V_NUMERIC) Then GoTo Catch
|
|
bSet = Resize(Width := pvValue)
|
|
Case Else
|
|
bSet = False
|
|
End Select
|
|
|
|
Finally:
|
|
_PropertySet = bSet
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
bSet = False
|
|
GoTo Finally
|
|
End Function ' SFDialogs.SF_Dialog._PropertySet
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _RegisterPageListener(ByVal psControlName As String _
|
|
, ByVal psControlTypes As String _
|
|
, ByVal piMgtType As Integer _
|
|
, ByVal plPageNumber As Long _
|
|
, ByVal piListener As Integer _
|
|
) As Boolean
|
|
''' Insert a new entry in the _PageManagement array when 1st argument is a listbox, a combobox or a button
|
|
''' or insert a new entry in the _PageManagement array by radio button in the same group as the 1st argument
|
|
''' Args:
|
|
''' psControlName: name of the involved control
|
|
''' psControlTypes: comma-separated list of allowed control types
|
|
''' piMgtType: one of the PILOTCONTROL, TABCONTROL, BACKCONTROL, NEXTCONTROL constants
|
|
''' plPageNumber: when > 0 the page to jump to when control is clicked
|
|
''' piListener: one of the ACTIONPERFORMED, ITEMSTATECHANGED constants
|
|
|
|
Dim bRegister As Boolean ' Return value
|
|
Dim oControl As Object ' A DialogControl object
|
|
Dim oControl2 As Object ' An alternative DialogControl object for radio buttons
|
|
Dim vControls As Variant ' Array of involved controls - mostly 1 item, more when radio button
|
|
Dim oPageManager As Object ' Type _PageManager
|
|
Dim bRadio As Boolean ' True when argument is a radio button
|
|
Dim sName As String ' Control name
|
|
Dim i As Long
|
|
|
|
Check:
|
|
On Local Error GoTo Catch
|
|
bRegister = False
|
|
|
|
Try:
|
|
Set oControl = Controls(psControlName)
|
|
With oControl
|
|
' Check the type of control otherwise return False
|
|
If InStr(psControlTypes, .ControlType) = 0 Then GoTo Catch
|
|
' Are there siblings ? Siblings are returned as a comma-separated list of names
|
|
bRadio = ( .ControlType = "RadioButton")
|
|
If bRadio Then vControls = Split(_FindRadioSiblings(.Name), ",") Else vControls = Array(.Name)
|
|
' Several loops when radio buttons
|
|
For i = 0 To UBound(vControls)
|
|
sName = vControls(i)
|
|
' Prepare the next entry in the _PageManagement array
|
|
Set oPageManager = New _PageManager
|
|
With oPageManager
|
|
.ControlName = sName
|
|
.PageMgtType = piMgtType
|
|
.PageNumber = Iif(bRadio, i + 1, plPageNumber)
|
|
.ListenerType = piListener
|
|
End With
|
|
_PageManagement = ScriptForge.SF_Array.Append(_PageManagement, oPageManager)
|
|
' Activate the listener
|
|
' Use alternative control for radio buttons > first
|
|
If i = 0 Then Set oControl2 = oControl Else Set oControl2 = Controls(sName)
|
|
With oControl2
|
|
If piListener = ACTIONPERFORMED Then
|
|
._ControlView.addActionListener(_ActionListener)
|
|
ElseIf piListener = ITEMSTATECHANGED Then
|
|
._ControlView.addItemListener(_ItemListener)
|
|
End If
|
|
End With
|
|
Next i
|
|
End With
|
|
|
|
bRegister = True
|
|
|
|
Finally:
|
|
_RegisterPageListener = bRegister
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDialogs.SF_Dialog._RegisterPageListener
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Sub _RemoveAllListeners()
|
|
''' Executed at dialog termination to drop at once all listeners set
|
|
''' either by the page manager or by an On-property setting
|
|
|
|
Dim oPageManager As Object ' Item of _PageManagement array of _PageManager type
|
|
Dim oControl As Object ' DialogControl instance
|
|
Dim i As Long
|
|
|
|
On Local Error GoTo Finally ' Never interrupt
|
|
|
|
Try:
|
|
' Scan the _PageManagement array containing the actual settings of the page manager
|
|
For Each oPageManager In _PageManagement
|
|
With oPageManager
|
|
If .ListenerType > 0 Then
|
|
Set oControl = Controls(.ControlName)
|
|
If .ListenerType = ACTIONPERFORMED Then
|
|
oControl._ControlView.removeActionListener(_ActionListener)
|
|
ElseIf .ListenerType = ITEMSTATECHANGED Then
|
|
oControl._ControlView.removeItemListener(_ItemListener)
|
|
End If
|
|
End If
|
|
End With
|
|
Next oPageManager
|
|
|
|
Set _ActionListener = Nothing
|
|
Set _ItemListener = Nothing
|
|
|
|
' Clean listeners linked to On properties
|
|
With _DialogControl
|
|
If Not IsNull(_FocusListener) Then .removeFocusListener(_FocusListener)
|
|
If Not IsNull(_KeyListener) Then .removeKeyListener(_KeyListener)
|
|
If Not IsNull(_MouseListener) Then .removeMouseListener(_MouseListener)
|
|
If Not IsNull(_MouseMotionListener) Then .removeMouseMotionListener(_MouseMotionListener)
|
|
End With
|
|
|
|
Set _FocusListener = Nothing
|
|
Set _KeyListener = Nothing
|
|
Set _MouseListener = Nothing
|
|
Set _MouseMotionListener = Nothing
|
|
|
|
Finally:
|
|
Exit Sub
|
|
End Sub ' SFDialogs.SF_Dialog._RemoveAllListeners
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _Repr() As String
|
|
''' Convert the Model instance to a readable string, typically for debugging purposes (DebugPrint ...)
|
|
''' Args:
|
|
''' Return:
|
|
''' "[DIALOG]: Container.Library.Name"
|
|
|
|
_Repr = "[DIALOG]: " & _Container & "." & _Library & "." & _Name
|
|
|
|
End Function ' SFDialogs.SF_Dialog._Repr
|
|
|
|
REM ============================================ END OF SFDIALOGS.SF_DIALOG
|
|
</script:module> |