12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484 |
- <?xml version="1.0" encoding="UTF-8"?>
- <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
- <script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Dialog" script:language="StarBasic" script:moduleType="normal">REM =======================================================================================================================
- REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. ===
- REM === The SFDialogs library is one of the associated libraries. ===
- REM === Full documentation is available on https://help.libreoffice.org/ ===
- REM =======================================================================================================================
- Option Compatible
- Option ClassModule
- Option Explicit
- '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
- ''' SF_Dialog
- ''' =========
- ''' Management of dialogs defined with the Basic IDE
- ''' Each instance of the current class represents a single dialog box displayed to the user
- '''
- ''' A dialog box can be displayed in modal or in non-modal modes
- ''' In modal mode, the box is displayed and the execution of the macro process is suspended
- ''' until one of the OK or Cancel buttons is pressed. In the meantime, other user actions
- ''' executed on the box can trigger specific actions.
- ''' In non-modal mode, the dialog box is "floating" on the user desktop and the execution
- ''' of the macro process continues normally
- ''' A dialog box disappears from memory after its explicit termination.
- '''
- ''' Service invocation and usage:
- ''' Dim myDialog As Object, lButton As Long
- ''' Set myDialog = CreateScriptService("SFDialogs.Dialog", Container, Library, DialogName)
- ''' ' Args:
- ''' ' Container: "GlobalScope" for preinstalled libraries
- ''' ' A window name (see its definition in the ScriptForge.UI service)
- ''' ' "" (default) = the current document
- ''' ' Library: The (case-sensitive) name of a library contained in the container
- ''' ' Default = "Standard"
- ''' ' DialogName: a case-sensitive string designating the dialog where it is about
- ''' ' ... Initialize controls ...
- ''' lButton = myDialog.Execute() ' Default mode = Modal
- ''' If lButton = myDialog.OKBUTTON Then
- ''' ' ... Process controls and do what is needed
- ''' End If
- ''' myDialog.Terminate()
- '''
- ''' 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"
- REM ============================================================= PRIVATE MEMBERS
- Private [Me] As Object
- Private [_Parent] As Object
- Private ObjectType As String ' Must be DIALOG
- Private ServiceName As String
- ' Dialog location
- Private _Container As String
- Private _Library As String
- Private _Name As String
- Private _CacheIndex As Long ' Index in cache storage
- ' Dialog UNO references
- Private _DialogProvider As Object ' com.sun.star.io.XInputStreamProvider
- Private _DialogControl As Object ' com.sun.star.awt.XControl - stardiv.Toolkit.UnoDialogControl
- Private _DialogModel As Object ' com.sun.star.awt.XControlModel - stardiv.Toolkit.UnoControlDialogModel
- ' Dialog attributes
- Private _Displayed As Boolean ' True after Execute()
- Private _Modal As Boolean ' Set by Execute()
- ' Dialog position and dimensions
- 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
- ' 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 OKBUTTON = 1
- Private Const CANCELBUTTON = 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 = ""
- _Name = ""
- _CacheIndex = -1
- Set _DialogProvider = Nothing
- Set _DialogControl = Nothing
- Set _DialogModel = Nothing
- _Displayed = False
- _Modal = True
- _Left = -1
- _Top = -1
- _Width = -1
- _Height = -1
- _PageManagement = Array()
- Set _ItemListener = Nothing
- Set _ActionListener = Nothing
- _LastPage = 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 Caption() As Variant
- ''' The Caption property refers to the title of the dialog
- Caption = _PropertyGet("Caption")
- End Property ' SFDialogs.SF_Dialog.Caption (get)
- REM -----------------------------------------------------------------------------
- Property Let Caption(Optional ByVal pvCaption As Variant)
- ''' Set the updatable property Caption
- _PropertySet("Caption", pvCaption)
- End Property ' SFDialogs.SF_Dialog.Caption (let)
- REM -----------------------------------------------------------------------------
- Property Get Height() As Variant
- ''' The Height property refers to the height of the dialog box
- Height = _PropertyGet("Height")
- End Property ' SFDialogs.SF_Dialog.Height (get)
- REM -----------------------------------------------------------------------------
- Property Let Height(Optional ByVal pvHeight As Variant)
- ''' Set the updatable property Height
- _PropertySet("Height", pvHeight)
- End Property ' SFDialogs.SF_Dialog.Height (let)
- REM -----------------------------------------------------------------------------
- Property Get Modal() As Boolean
- ''' The Modal property specifies if the dialog box has been executed in modal mode
- Modal = _PropertyGet("Modal")
- End Property ' SFDialogs.SF_Dialog.Modal (get)
- REM -----------------------------------------------------------------------------
- Property Get Name() As String
- ''' Return the name of the actual dialog
- Name = _PropertyGet("Name")
- End Property ' SFDialogs.SF_Dialog.Name
- REM -----------------------------------------------------------------------------
- Property Get OnFocusGained() As Variant
- ''' Get the script associated with the OnFocusGained event
- OnFocusGained = _PropertyGet("OnFocusGained")
- End Property ' SFDialogs.SF_Dialog.OnFocusGained (get)
- 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 Get OnKeyPressed() As Variant
- ''' Get the script associated with the OnKeyPressed event
- OnKeyPressed = _PropertyGet("OnKeyPressed")
- End Property ' SFDialogs.SF_Dialog.OnKeyPressed (get)
- 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 Get OnMouseDragged() As Variant
- ''' Get the script associated with the OnMouseDragged event
- OnMouseDragged = _PropertyGet("OnMouseDragged")
- End Property ' SFDialogs.SF_Dialog.OnMouseDragged (get)
- 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 Get OnMouseExited() As Variant
- ''' Get the script associated with the OnMouseExited event
- OnMouseExited = _PropertyGet("OnMouseExited")
- End Property ' SFDialogs.SF_Dialog.OnMouseExited (get)
- 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 Get OnMousePressed() As Variant
- ''' Get the script associated with the OnMousePressed event
- OnMousePressed = _PropertyGet("OnMousePressed")
- End Property ' SFDialogs.SF_Dialog.OnMousePressed (get)
- 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 Get Page() As Variant
- ''' A dialog may have several pages that can be traversed by the user step by step.
- ''' The Page property of the Dialog object defines which page of the dialog is active.
- ''' The Page property of a control defines the page of the dialog on which the control is visible.
- ''' For example, if a control has a page value of 1, it is only visible on page 1 of the dialog.
- ''' If the page value of the dialog is increased from 1 to 2, then all controls with a page value of 1 disappear
- ''' and all controls with a page value of 2 become visible.
- Page = _PropertyGet("Page")
- End Property ' SFDialogs.SF_Dialog.Page (get)
- REM -----------------------------------------------------------------------------
- Property Let Page(Optional ByVal pvPage As Variant)
- ''' Set the updatable property Page
- _PropertySet("Page", pvPage)
- End Property ' SFDialogs.SF_Dialog.Page (let)
- REM -----------------------------------------------------------------------------
- Property Get Visible() As Variant
- ''' The Visible property is False before the Execute() statement
- Visible = _PropertyGet("Visible")
- End Property ' SFDialogs.SF_Dialog.Visible (get)
- REM -----------------------------------------------------------------------------
- Property Let Visible(Optional ByVal pvVisible As Variant)
- ''' Set the updatable property Visible
- _PropertySet("Visible", pvVisible)
- End Property ' SFDialogs.SF_Dialog.Visible (let)
- REM -----------------------------------------------------------------------------
- Property Get Width() As Variant
- ''' The Width property refers to the Width of the dialog box
- Width = _PropertyGet("Width")
- End Property ' SFDialogs.SF_Dialog.Width (get)
- REM -----------------------------------------------------------------------------
- Property Let Width(Optional ByVal pvWidth As Variant)
- ''' Set the updatable property Width
- _PropertySet("Width", pvWidth)
- End Property ' SFDialogs.SF_Dialog.Width (let)
- REM -----------------------------------------------------------------------------
- Property Get XDialogModel() As Object
- ''' The XDialogModel property returns the model UNO object of the dialog
- XDialogModel = _PropertyGet("XDialogModel")
- End Property ' SFDialogs.SF_Dialog.XDialogModel (get)
- REM -----------------------------------------------------------------------------
- Property Get XDialogView() As Object
- ''' The XDialogView property returns the view UNO object of the dialog
- XDialogView = _PropertyGet("XDialogView")
- End Property ' SFDialogs.SF_Dialog.XDialogView (get)
- REM ===================================================================== METHODS
- REM -----------------------------------------------------------------------------
- Public Function Activate() As Boolean
- ''' Set the focus on the current dialog instance
- ''' Probably called from after an event occurrence or to focus on a non-modal dialog
- ''' Args:
- ''' Returns:
- ''' True if focusing is successful
- ''' Example:
- ''' Dim oDlg As Object
- ''' Set oDlg = CreateScriptService(,, "myDialog") ' Dialog stored in current document's standard library
- ''' oDlg.Activate()
- Dim bActivate As Boolean ' Return value
- Const cstThisSub = "SFDialogs.Dialog.Activate"
- Const cstSubArgs = ""
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- bActivate = False
- Check:
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not _IsStillAlive() Then GoTo Finally
- End If
- Try:
- If Not IsNull(_DialogControl) Then
- _DialogControl.setFocus()
- bActivate = True
- End If
- Finally:
- Activate = bActivate
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' SFDialogs.SF_Dialog.Activate
- REM -----------------------------------------------------------------------------
- Public Function 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 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)
- ._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())
- GoTo Finally
- End Function ' SFDialogs.SF_Dialog.Controls
- REM -----------------------------------------------------------------------------
- Public Sub EndExecute(Optional ByVal ReturnValue As Variant)
- ''' Ends the display of a modal dialog and gives back the argument
- ''' as return value for the current Execute() action
- ''' EndExecute is usually contained in the processing of a macro
- ''' triggered by a dialog or control event
- ''' Args:
- ''' ReturnValue: must be numeric. The value passed to the running Execute() method
- ''' Example:
- ''' Sub OnEvent(poEvent As Variant)
- ''' Dim oDlg As Object
- ''' Set oDlg = CreateScriptService("SFDialogs.DialogEvent", poEvent)
- ''' oDlg.EndExecute(25)
- ''' End Sub
- Dim lExecute As Long ' Alias of ReturnValue
- Const cstThisSub = "SFDialogs.Dialog.EndExecute"
- Const cstSubArgs = "ReturnValue"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- Check:
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not _IsStillAlive() Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(ReturnValue, "ReturnValue", V_NUMERIC) Then GoTo Finally
- End If
- Try:
- lExecute = CLng(ReturnValue)
- Call _DialogControl.endDialog(lExecute)
- Finally:
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Sub
- Catch:
- GoTo Finally
- End Sub ' SFDialogs.SF_Dialog.EndExecute
- REM -----------------------------------------------------------------------------
- Public Function Execute(Optional ByVal Modal As Variant) As Long
- ''' Display the dialog and wait for its termination by the user
- ''' Args:
- ''' Modal: False when non-modal dialog. Default = True
- ''' Returns:
- ''' 0 = Cancel button pressed
- ''' 1 = OK button pressed
- ''' Otherwise: the dialog stopped with an EndExecute statement executed from a dialog or control event
- ''' Example:
- ''' Dim oDlg As Object, lReturn As Long
- ''' Set oDlg = CreateScriptService(,, "myDialog") ' Dialog stored in current document's standard library
- ''' lReturn = oDlg.Execute()
- ''' Select Case lReturn
- Dim lExecute As Long ' Return value
- Const cstThisSub = "SFDialogs.Dialog.Execute"
- Const cstSubArgs = "[Modal=True]"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- lExecute = -1
- Check:
- If IsMissing(Modal) Or IsEmpty(Modal) Then Modal = True
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not _IsStillAlive() Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(Modal, "Modal", V_BOOLEAN) Then GoTo Finally
- End If
- Try:
- If Modal Then
- _Modal = True
- _Displayed = True
- lExecute = _DialogControl.execute()
- Select Case lExecute
- Case 1 : lExecute = OKBUTTON
- Case 0 : lExecute = CANCELBUTTON
- Case Else
- End Select
- _Displayed = False
- Else
- _Modal = False
- _Displayed = True
- _DialogModel.DesktopAsParent = True
- _DialogControl.setVisible(True)
- lExecute = 0
- End If
- Finally:
- Execute = lExecute
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- ' 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" _
- , "Controls" _
- , "EndExecute" _
- , "Execute" _
- , "GetTextsFromL10N" _
- , "Resize" _
- , "SetPageManager" _
- , "Terminate" _
- )
- End Function ' SFDialogs.SF_Dialog.Methods
- REM -----------------------------------------------------------------------------
- Public Function Properties() As Variant
- ''' Return the list or properties of the Dialog class as an array
- Properties = Array( _
- "Caption" _
- , "Height" _
- , "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 a dialog to new coordinates and/or modify its dimensions
- ''' All distances are expressed in 1/100 mm.
- ''' Without arguments, the method resets the initial dimensions
- ''' Args:
- ''' Left : the horizontal distance from the top-left corner
- ''' Top : the vertical distance from the top-left corner
- ''' Width : the horizontal width of the rectangle containing the Dialog
- ''' Height : the vertical height of the rectangle containing the Dialog
- ''' Negative or missing arguments are left unchanged
- ''' Returns:
- ''' True when successful
- ''' Examples:
- ''' oDialog.Resize(1000, 2000, Height := 6000) ' Width is not changed
- Dim bResize As Boolean ' Return value
- Dim oPosSize As Object ' com.sun.star.awt.Rectangle
- Dim iFlags As Integer ' com.sun.star.awt.PosSize constants
- Const cstThisSub = "SFDialogs.Dialog.Resize"
- Const cstSubArgs = "[Left], [Top], [Width], [Height]"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- bResize = False
- Check:
- If IsMissing(Left) Or IsEmpty(Left) Then Left = -1
- If IsMissing(Top) Or IsEmpty(Top) Then Top = -1
- If IsMissing(Height) Or IsEmpty(Height) Then Height = -1
- If IsMissing(Width) Or IsEmpty(Width) Then Width = -1
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- 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
- If Not ScriptForge.SF_Utils._Validate(Width, "Width", ScriptForge.V_NUMERIC) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(Height, "Height", ScriptForge.V_NUMERIC) Then GoTo Finally
- End If
- Try:
- With _DialogControl
- Set oPosSize = .getPosSize()
- ' Reset factory settings
- If Left = -1 And Top = -1 And Width = -1 And Height = -1 Then
- 'Left = _Left ' Initial positions determination is unstable
- 'Top = _Top
- Width = _Width
- Height = _Height
- End If
- ' Trace the elements to change
- iFlags = 0
- With com.sun.star.awt.PosSize
- If Left >= 0 Then iFlags = iFlags + .X Else Left = oPosSize.X
- If Top >= 0 Then iFlags = iFlags + .Y Else Top = oPosSize.Y
- If Width > 0 Then iFlags = iFlags + .WIDTH Else Width = oPosSize.Width
- If Height > 0 Then iFlags = iFlags + .HEIGHT Else Height = oPosSize.Height
- End With
- ' Rewrite
- If iFlags > 0 Then .setPosSize(CLng(Left), CLng(Top), CLng(Width), CLng(Height), iFlags)
- End With
- bResize = True
- Finally:
- Resize = bResize
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' SF_Documents.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:
- _RemovePageListeners()
- _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 _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 oPosSize As Object ' com.sun.star.awt.Rectangle
- Try:
- ' Keep reference to model
- Set _DialogModel = _DialogControl.Model
- ' Store initial position and dimensions
- Set oPosSize = _DialogControl.getPosSize()
- With oPosSize
- _Left = .X
- _Top = .Y
- _Width = .Width
- _Height = .Height
- End With
- ' Add dialog reference to cache
- _CacheIndex = SF_Register._AddDialogToCache(_DialogControl, [Me])
- ' Size the persistent storage
- _ControlCache = Array()
- ReDim _ControlCache(0 To UBound(_DialogModel.getElementNames()))
- Finally:
- Exit Sub
- End Sub ' SFDialogs.SF_Dialog._Initialize
- REM -----------------------------------------------------------------------------
- Private Function _IsStillAlive(Optional ByVal pbError As Boolean) As Boolean
- ''' Return True if the dialog service is still active
- ''' If dead the actual instance is disposed. The execution is cancelled when pbError = True (default)
- ''' Args:
- ''' pbError: if True (default), raise a fatal error
- Dim bAlive As Boolean ' Return value
- Dim sDialog As String ' Alias of DialogName
- Check:
- On Local Error GoTo Catch ' Anticipate DisposedException errors or alike
- If IsMissing(pbError) Then pbError = True
- Try:
- bAlive = ( Not IsNull(_DialogProvider) And Not IsNull(_DialogControl) )
- If Not bAlive Then GoTo Catch
- Finally:
- _IsStillAlive = bAlive
- Exit Function
- Catch:
- bAlive = False
- On Error GoTo 0
- sDialog = _Name
- Dispose()
- If pbError Then ScriptForge.SF_Exception.RaiseFatal(DIALOGDEADERROR, sDialog)
- GoTo Finally
- End Function ' SFDialogs.SF_Dialog._IsStillAlive
- REM -----------------------------------------------------------------------------
- Private 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 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 Not _IsStillAlive() Then GoTo Finally
- 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 oSession.HasUNOProperty(_DialogModel, "Height") Then _PropertyGet = _DialogModel.Height
- 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")
- Set oDialogEvents = _DialogModel.getEvents()
- sEventName = "com.sun.star.awt." & _GetListener(psProperty) & "::" & _GetEventName(psProperty)
- If oDialogEvents.hasByName(sEventName) Then
- _PropertyGet = oDialogEvents.getByName(sEventName).ScriptCode
- Else
- _PropertyGet = ""
- 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 oSession.HasUNOProperty(_DialogModel, "Width") Then _PropertyGet = _DialogModel.Width
- 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 Finally
- If oSession.HasUNOProperty(_DialogModel, "Title") Then _DialogModel.Title = pvValue
- Case UCase("Height")
- If Not ScriptForge.SF_Utils._Validate(pvValue, "Height", ScriptForge.V_NUMERIC) Then GoTo Finally
- If oSession.HasUNOProperty(_DialogModel, "Height") Then _DialogModel.Height = pvValue
- Case UCase("Page")
- If Not ScriptForge.SF_Utils._Validate(pvValue, "Page", ScriptForge.V_NUMERIC) Then GoTo Finally
- If oSession.HasUNOProperty(_DialogModel, "Step") Then
- _DialogModel.Step = CLng(pvValue)
- ' 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 Finally
- If oSession.HasUnoMethod(_DialogControl, "setVisible") Then _DialogControl.setVisible(pvValue)
- Case UCase("Width")
- If Not ScriptForge.SF_Utils._Validate(pvValue, "Width", ScriptForge.V_NUMERIC) Then GoTo Finally
- If oSession.HasUNOProperty(_DialogModel, "Width") Then _DialogModel.Width = pvValue
- Case Else
- bSet = False
- End Select
- Finally:
- _PropertySet = bSet
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' SFDialogs.SF_Dialog._PropertySet
- REM -----------------------------------------------------------------------------
- Private Function _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 _RemovePageListeners()
- ''' Executed at dialog termination to drop at once all listeners set by the page manager
- 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.addItemListener(_ItemListener)
- End If
- End If
- End With
- Next oPageManager
- Set _ActionListener = Nothing
- Set _ItemListener = Nothing
- Finally:
- Exit Sub
- End Sub ' SFDialogs.SF_Dialog._RemovePageListeners
- 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>
|