Quelle  SF_DialogUtils.xba   Sprache: unbekannt

<?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_DialogUtils" 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 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

</script:module>