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 Explicit Option Private Module ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''' SF_DialogUtils ''' ======== ''' FOR INTERNAL USE ONLY ''' Groups private functions that are common to the SF_Dialog and SF_DialogControl class modules ''' ''' Topics where SF_DialogUtils matters: ''' - resizing dialog and dialog controls ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' REM ================================================================== EXCEPTIONS REM ============================================================ MODULE CONSTANTS Public Const MINPOSITION = -99999 ' Conventionally indicates "do not change position" REM =========================================pvA================= PRIVATE METHODS REM ----------------------------------------------------------------------------- Public Function _ConvertPointToAppFont(ByRef poView As Object _ , ByVal plX As Long _ , ByVal plY As Long _ ) As Object ''' Convert the X, Y position expressed in pixels to a Point expressed in "Map APPFONT" ''' Args: ''' poView: a com.sun.star.awt.XControl - stardiv.Toolkit.UnoDialogControl ''' plX, plY : the horizontal and vertical coordinates of the top-left corner of the control ''' Returns: ''' a com.sun.star.awt.Point object Dim oPoint As New com.sun.star.awt.Point ' The input Point Dim oReturn As Object ' Return value Try: oPoint.X = plX oPoint.Y = plY Set oReturn = poView.convertPointToLogic(oPoint, com.sun.star.util.MeasureUnit.APPFONT) Finally: Set _ConvertPointToAppFont = oReturn Exit Function End Function ' SFDialogs.SF_DialogUtils._ConvertPointToAppFont REM ----------------------------------------------------------------------------- Public Function _ConvertPointToPixel(ByRef poView As Object _ , ByVal plX As Long _ , ByVal plY As Long _ ) As Object ''' Convert the X, Y coordinates expressed in "Map APPFONT" units to a point expressed in pixels ''' Args: ''' poView: a com.sun.star.awt.XControl - stardiv.Toolkit.UnoDialogControl ''' plX, plY : the horizontal and vertical coordinates of the top-left corner of the control ''' Returns: ''' a com.sun.star.awt.Point object Dim oPoint As New com.sun.star.awt.Point ' The input point Dim oReturn As Object ' Return value Try: oPoint.X = plX oPoint.Y = plY Set oReturn = poView.convertPointToPixel(oPoint, com.sun.star.util.MeasureUnit.APPFONT) Finally: Set _ConvertPointToPixel = oReturn Exit Function End Function ' SFDialogs.SF_DialogUtils._ConvertPointToPixel REM ----------------------------------------------------------------------------- Public Function _ConvertSizeToAppFont(ByRef poView As Object _ , ByVal plWidth As Long _ , ByVal plHeight As Long _ ) As Object ''' Convert the Width, Height dimensions expressed in pixels to a Size expressed in "Map APPFONT" ''' Args: ''' poView: a com.sun.star.awt.XControl - stardiv.Toolkit.UnoDialogControl ''' plWidth, plHeight : the horizontal and vertical dimensions of the control ''' Returns: ''' a com.sun.star.awt.Size object Dim oSize As New com.sun.star.awt.Size ' The input size Dim oReturn As Object ' Return value Try: oSize.Width = plWidth oSize.Height = plHeight Set oReturn = poView.convertSizeToLogic(oSize, com.sun.star.util.MeasureUnit.APPFONT) Finally: Set _ConvertSizeToAppFont = oReturn Exit Function End Function ' SFDialogs.SF_DialogUtils._ConvertSizeToAppFont REM ----------------------------------------------------------------------------- Public Function _ConvertSizeToPixel(ByRef poView As Object _ , ByVal plWidth As Long _ , ByVal plHeight As Long _ ) As Object ''' Convert the Width, Height dimensions expressed in "Map APPFONT" units to a Size expressed in pixels ''' Args: ''' poView: a com.sun.star.awt.XControl - stardiv.Toolkit.UnoDialogControl ''' plWidth, plHeight : the horizontal and vertical dimensions of the control ''' Returns: ''' a com.sun.star.awt.Size object Dim oSize As New com.sun.star.awt.Size ' The input size Dim oReturn As Object ' Return value Try: oSize.Width = plWidth oSize.Height = plHeight Set oReturn = poView.convertSizeToPixel(oSize, com.sun.star.util.MeasureUnit.APPFONT) Finally: Set _ConvertSizeToPixel = oReturn Exit Function End Function ' SFDialogs.SF_DialogUtils._ConvertSizeToPixel REM ----------------------------------------------------------------------------- Public Function _ConvertToAppFont(ByRef poView As Object _ , ByVal pbPoint As Boolean _ ) As Object ''' Switch between the _ConvertPointToAppFont and the _ConvertSizeToAppFont routines ''' Args: ''' poView: a com.sun.star.awt.XControl - stardiv.Toolkit.UnoDialogControl ''' pbPoint: when True return a Point, otherwise return a Size ''' Returns: ''' a com.sun.star.awt.Point or a com.sun.star.awt.Size object Static oSession As Object ' Alias of SF_Session Dim oPosSize As Object ' com.sun.star.awt.Rectangle Try: If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session") If oSession.HasUNOMethod(poView, "getPosSize") Then Set oPosSize =poView.getPosSize() Else ' Should not happen Set oPosSize = New com.sun.star.awt.Rectangle End If If pbPoint Then _ConvertToAppFont = _ConvertPointToAppFont(poView, oPosSize.X, oPosSize.Y) ' com.sun.star.awt.Point Else _ConvertToAppFont = _ConvertSizeToAppFont(poView, oPosSize.Width, oPosSize.Height) ' com.sun.star.awt.Size End If End Function ' SFDialogs.SF_DialogUtils._ConvertToAppFont REM ----------------------------------------------------------------------------- Private Function _FormatsList(psControlType) As Variant ''' Return the list of the allowed formats for Date and Time control types ''' Args: ''' DateField or TimeField control ''' Returns: ''' The allowed format entries as a zero-based array Dim vFormats() As Variant ' Return value Const CTLDATEFIELD = "DateField" Const CTLTIMEFIELD = "TimeField" Select Case psControlType Case CTLDATEFIELD vFormats = Array( _ "Standard (short)" _ , "Standard (short YY)" _ , "Standard (short YYYY)" _ , "Standard (long)" _ , "DD/MM/YY" _ , "MM/DD/YY" _ , "YY/MM/DD" _ , "DD/MM/YYYY" _ , "MM/DD/YYYY" _ , "YYYY/MM/DD" _ , "YY-MM-DD" _ , "YYYY-MM-DD" _ ) Case CTLTIMEFIELD vFormats = Array( _ "24h short" _ , "24h long" _ , "12h short" _ , "12h long" _ ) Case Else vFormats = Array() End Select _FormatsList = vFormats End Function ' SFDialogs.SF_DialogUtils._FormatsList REM ----------------------------------------------------------------------------- Public Function _Resize(ByRef Control As Object _ , 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 or a dialog control to new coordinates and/or modify its dimensions ''' Without arguments, the method either: ''' leaves the position unchanged and computes best fit dimensions ''' resets the initial position and dimensions (Scrollbar, ProgressBar, FixedLine, GroupBox, TreeControl", TableControl) ''' Attributes denoting the position and size of a dialog are expressed in "Map AppFont" units. ''' Map AppFont units are device and resolution independent. ''' One Map AppFont unit is equal to one eighth of the average character (Systemfont) height and one quarter of the average character width. ''' The dialog editor (= the Basic IDE) also uses Map AppFont units. ''' Args: ''' Control: a SF_Dialog or SF_DialogControl class instance ''' 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[Control] ''' Height : the vertical height of the rectangle containing the Dialog[Control] ''' Negative or missing arguments are left unchanged. ''' Returns: ''' True when successful Dim bResize As Boolean ' Return value Dim oModel As Object ' Model of Control object Dim oView As Object ' View of Control object Dim Displayed As Boolean ' When Trs, the dialog is currently active Dim oSize As Object ' com.sun.star.awt.Size Dim oPoint As Object ' com.sun.star.awt.Point Dim oPreferredSize As Object ' com.sun.star.awt.Size Dim iFlags As Integer ' com.sun.star.awt.PosSize constants Static oSession As Object ' SF_Session alias Dim cstThisSub As String Const cstSubArgs = "[Left], [Top], [Width], [Height]" If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch bResize = False Check: If IsNull(Control) Then GoTo Finally If IsMissing(Left) Or IsEmpty(Left) Then Left = MINPOSITION If IsMissing(Top) Or IsEmpty(Top) Then Top = MINPOSITION 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 Control ' Initialize local variables depending on caller Select Case .ObjectType Case "DIALOG" cstThisSub = "SFDialogs.Dialog.Resize" Set oModel = ._DialogModel Set oView = ._DialogControl Displayed = ._Displayed Case "DIALOGCONTROL" cstThisSub = "SFDialogs.DialogControl.Resize" Set oModel = ._ControlModel Set oView = ._ControlView Displayed = .[Parent]._Displayed Case Else End Select ' Manage absence of arguments: best fit or reset If Left = MINPOSITION And Top = MINPOSITION And Width = -1 And Height = -1 Then If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("ScriptForge.Session") If oSession.HasUnoMethod(oView, "getPreferredSize") Then ' Compute a best fit size when relevant Set oPreferredSize = oView.getPreferredSize() Set oSize = SF_DialogUtils._ConvertSizeToAppFont(oView, oPreferredSize.Width, oPreferredSize.Height) Width = oSize.Width Height = oSize.Height Else ' Reset factory settings otherwise Left = ._Left Top = ._Top Width = ._Width Height = ._Height End If End If End With ' Model sizes are in APPFONTs, View sizes are in pixels. Use view.convertSizeToPixel() to convert ' For dynamic dialogs: convertSizeToPixel() is available only as from the dialog is made visible ' => When the dialog is visible, positions and sizes are updated in view ' When the dialog is not visible, positions and sizes adapted on model If Displayed Then With oView ' Trace the elements to change iFlags = 0 With com.sun.star.awt.PosSize If Left > MINPOSITION Then iFlags = iFlags + .X Else Left = 0 If Top > MINPOSITION Then iFlags = iFlags + .Y Else Top = 0 If Width > 0 Then iFlags = iFlags + .WIDTH Else Width = 0 If Height > 0 Then iFlags = iFlags + .HEIGHT Else Height = 0 End With ' Convert APPFONT units to pixels Set oPoint = SF_DialogUtils._ConvertPointToPixel(oView, CLng(Left), CLng(Top)) Set oSize = SF_DialogUtils._ConvertSizeToPixel(oView, CLng(Width), CLng(Height)) ' Rewrite If iFlags > 0 Then .setPosSize(oPoint.X, oPoint.Y, oSize.Width, oSize.Height, iFlags) End With Else With oModel ' Store position and dimensions in APPFONT units If Left > MINPOSITION Then .PositionX = CLng(Left) If Top > MINPOSITION Then .PositionY = CLng(Top) If Width > 0 Then .Width = CLng(Width) If Height > 0 Then .Height = CLng(Height) End With End If bResize = True Finally: _Resize = bResize ScriptForge.SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' SFDialogss.SF_DialogUtils._Resize REM ============================================= END OF SFDIALOGS.SF_DIALOGUTILS