diff options
Diffstat (limited to 'wizards/source/sfdialogs/SF_Dialog.xba')
| -rw-r--r-- | wizards/source/sfdialogs/SF_Dialog.xba | 1111 |
1 files changed, 1111 insertions, 0 deletions
diff --git a/wizards/source/sfdialogs/SF_Dialog.xba b/wizards/source/sfdialogs/SF_Dialog.xba new file mode 100644 index 000000000..da2afcb4a --- /dev/null +++ b/wizards/source/sfdialogs/SF_Dialog.xba @@ -0,0 +1,1111 @@ +<?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" + +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 + +' Persistent storage for controls +Private _ControlCache As Variant ' Array of control objects sorted like ElementNames of the Dialog model + +REM ============================================================ MODULE CONSTANTS + +Private Const OKBUTTON = 1 +Private Const CANCELBUTTON = 0 + +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 + _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: + 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" _ + , "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 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: + _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 ----------------------------------------------------------------------------- +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 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) + 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 _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>
\ No newline at end of file |