Ask Your Question

Revision history [back]

click to hide/show revision 1
initial version

Hello @shma_lo,

To display a MessageBox with formatted text you could use the Xmessagebox interface, plus an injected RichText control to replace the normal plain text control.

When calling the below provided function MessageBox() in the following manner:

Dim strMsg As String : strMsg = "My name is " +chr(2)+ "John " +chr(2)+ "Roberts"
Dim aProps1(0) As New com.sun.star.beans.PropertyValue : aProps1(0).Name = "CharWeight" : aProps1(0).Value = 150.0
Dim aProps2(0) As New com.sun.star.beans.PropertyValue : aProps2(0).Name = "CharColor"  : aProps2(0).Value = rgb( 255, 10, 10 )
Dim aStyles() : aStyles = Array( Array(), aProps1, aProps2 )
MessageBox( strMsg, 2, "Family" , 1, aStyles, 170, 40 )

it produces the following dialog on my system Ubuntu 17.10:

Screenshot formatted MessageBox.png

To use the MessageBox() function, please copy-paste the entire code section below ( including the “empty” callback methods at the end ), into your Macro Library.

Global g_MessageBox As Object
Function MessageBox( strText$, Optional iMessageBoxType%, Optional strDialogTitle, Optional lMessageBoxButtons, Optional aTextPortionStyleProperties(), Optional lTextFieldWidth, Optional lTextFieldHeight, Optional rTextFieldFont, Optional lDialogPositionX, Optional lDialogPositionY, Optional lDialogBackgroundColor, Optional aButtonLabels(), Optional rButtonFont, Optional dButtonZoom, Optional iButtonPointer%, Optional oParentWindow As Object )
REM Display a customized XMessageBox with formatted text.
REM  <strText>      : The Message text to display.
REM                   TextPortions with different formatting can be separated using a Chr(2) character; each TextPortion can have its own Style Properties specified in the <aTextPortionStyleProperties> array.
REM                   TextPortions without a corresponding Style Properties array will be displayed in the default Font (<rTextFieldFont>).
REM                   NB. Style properties are reset after each TextPortion, and also after each paragraph break chr(13) and/or newline chr(10).
REM                   So if you want to include a Chr(13) or Chr(10) character inside your TextPortion, and there are more TextPortions following,
REM                   then that Chr(13) or Chr(10) character should be directly followed by a Chr(2) character, and a new StyleProperties Array should be added for it into the <aTextPortionStyleProperties> array.
REM  [OPTIONAL] <iMessageBoxType>   : Integer indicating which type of MessageBox to show; [DEFAULT]=0:
REM         0 = com.sun.star.awt.MessageBoxType.MESSAGEBOX      normal message box ( without icon ).
REM         1 = com.sun.star.awt.MessageBoxType.INFOBOX         message box to inform the user about a certain event.
REM         2 = com.sun.star.awt.MessageBoxType.WARNINGBOX      message box to warn the user about a certain problem.
REM         3 = com.sun.star.awt.MessageBoxType.ERRORBOX        message box to provide an error message to the user.
REM         4 = com.sun.star.awt.MessageBoxType.QUERYBOX        message box to query information from the user.
REM        NB. In the case that iMessageBoxType=INFOBOX, only the OK button will be shown, regardless of the specified <lMessageBoxButtons> value.
REM  [OPTIONAL] <strDialogTitle>    : String to appear in the MessageBox dialog titlebar; [DEFAULT]= Product Version String.
REM                                   Currently yields Error 448 if the Title string is wider than the Dialog Width.
REM  [OPTIONAL] <lMessageBoxButtons>: Long integer combination of com.sun.star.awt.MessageBoxButtons, indicating which buttons are to be shown; [DEFAULT]=65537:
REM         1=BUTTONS_OK;   2=BUTTONS_OK_CANCEL;   3=BUTTONS_YES_NO;   4=BUTTONS_YES_NO_CANCEL;   5=BUTTONS_RETRY_CANCEL;   6=BUTTONS_ABORT_IGNORE_RETRY;
REM         + one of : 65536=DEFAULT_BUTTON_OK;  131072=DEFAULT_BUTTON_CANCEL;  196608=DEFAULT_BUTTON_RETRY;  262144=DEFAULT_BUTTON_YES;  327680=DEFAULT_BUTTON_NO;  393216=DEFAULT_BUTTON_IGNORE.
REM                                   NB. These values differ from those of the built-in msgbox() method.
REM  [OPTIONAL] <aTextPortionStyleProperties> : Array containing an {Array with Style Properties} for each TextPortion in <strText>.
REM                                 Most of the CharacterProperties and only a few of the ParagraphProperties are supported by the RichText control.
REM  [OPTIONAL] <lTextFieldWidth> : Long integer holding the desired Width for our RichTextField; [DEFAULT]=350 pixels.
REM  [OPTIONAL] <lTextFieldHeight>: Long integer holding the desired Height for our RichTextField; [DEFAULT]=100 pixels.
REM                                 NB. The Dialog size will be based on the size of the RichTextField and on the size of the Buttons.
REM  [OPTIONAL] <rTextFieldFont>  : Structure of type=com.sun.star.awt.FontDescriptor describing the Default Font to be used for the RichTextField.
REM  [OPTIONAL] <lDialogPositionX>: Long integer representing the Parent Window X-coordinate ( in pixels ) for the TopLeft corner of the MessageBox; [DEFAULT]=Centered Horizontally on the Parent Window.
REM  [OPTIONAL] <lDialogPositionY>: Long integer representing the Parent Window Y-coordinate ( in pixels ) for the TopLeft corner of the MessageBox; [DEFAULT]=Centered Vertically on the Parent Window.
REM  [OPTIONAL] <lDialogBackgroundColor>: Long integer representing the ARGB/RGB Color for the MessageBox background.
REM  [OPTIONAL] <aButtonLabels>   : String Array containing custom Buttons Labels to be displayed instead of the default Labels.
REM                                 NB. All Buttons will assume the width of the Button with the widest Label.
REM  [OPTIONAL] <rButtonFont>     : Structure of type=com.sun.star.awt.FontDescriptor describing the Font to be used for the MessageBox Buttons.
REM  [OPTIONAL] <dButtonZoom>     : Double representing the Horizontal and Vertical Zoom Factor for the Buttons; [DEFAULT]=1.0.
REM  [OPTIONAL] <iButtonPointer>  : Integer of type com.sun.star.awt.SystemPointer, specifying which Mouse Pointer to use inside the Buttons; [DEFAULT]=0.
REM  [OPTIONAL] <oParentWindow>   : The Window that is the owner of our MessageBox; [DEFAULT]=Current Component Window.
REM This Function returns the number of the button that the user chose.

REM Example Call:
'   MessageBox( "Hello", 2, "Title" , 1, , 170, 50 )

REM ****  Work in Progress  ****
REM TODO: set icon size;  set custom icon;  autosize dialog based on text contents;  richtext markdown support.

REM *********************************** BEGIN MessageBox()
'   On Local Error Resume Next          REM Enabling this line could lead to incorrect formatting in case an invalid Style Property was specified.

    Const lTextFieldWidth_Default  As Long  = 350       REM Default Width for our RichTextField.
    Const lTextFieldHeight_Default As Long  = 75        REM Default Height for our RichTextField.
    Const lTextFieldWidth_Minimum  As Long  = 24        REM Minimum Width for our RichTextField.
    Const lTextFieldHeight_Minimum As Long  = 24        REM Minimum Height for our RichTextField.

    Dim strTextPortionSeparator As String   : strTextPortionSeparator  = chr(2)

    If IsMissing( oParentWindow ) Or IsNull( oParentWindow ) Then oParentWindow = ThisComponent.CurrentController.Frame.getContainerWindow()
    If IsNull( oParentWindow )     Then oParentWindow = ThisDatabaseDocument.CurrentController.Frame.getContainerWindow()
    If IsNull( oParentWindow )     Then oParentWindow = StarDesktop
    If Not IsNull( oParentWindow ) Then
        If IsMissing( strDialogTitle )   Then strDialogTitle = "LibreOffice " & Join( Split( getSolarVersion(), "0" ), "." )
        If IsMissing( iMessageBoxType ) Or iMessageBoxType < 0 Or iMessageBoxType > 4 Then iMessageBoxType = com.sun.star.awt.MessageBoxType.MESSAGEBOX
        If IsMissing( lMessageBoxButtons ) Or lMessageBoxButtons < 1 Then lMessageBoxButtons = com.sun.star.awt.MessageBoxButtons.BUTTONS_OK + com.sun.star.awt.MessageBoxButtons.DEFAULT_BUTTON_OK
        Dim iButtonsOnly As Integer : iButtonsOnly = lMessageBoxButtons And &HF
        If iButtonsOnly > 6 Then lMessageBoxButtons = com.sun.star.awt.MessageBoxButtons.BUTTONS_OK + com.sun.star.awt.MessageBoxButtons.DEFAULT_BUTTON_OK

        Dim oToolkit As Object  : oToolkit = oParentWindow.getToolkit()
        Dim oMsgBox As Object   : oMsgBox  = oToolkit.createMessageBox( oParentWindow,_
                                                                      iMessageBoxType,_
                                                                   lMessageBoxButtons,_
                                                                       strDialogTitle,_
                                                                                   "" )

        If IsMissing( lTextFieldWidth )  Then lTextFieldWidth  = lTextFieldWidth_Default
        If IsMissing( lTextFieldHeight ) Then lTextFieldHeight = lTextFieldHeight_Default
        If lTextFieldWidth  < lTextFieldWidth_Minimum   Then  lTextFieldWidth  = lTextFieldWidth_Minimum
        If lTextFieldHeight < lTextFieldHeight_Minimum  Then  lTextFieldHeight = lTextFieldHeight_Minimum
        If IsMissing( rTextFieldFont ) Then rTextFieldFont = oMsgBox.StyleSettings.LabelFont            REM Default Text Font.
        If Not IsMissing( lDialogBackgroundColor ) Then oMsgBox.setBackground( lDialogBackgroundColor ) REM Dialog Background Color.

    REM Button Mouse Pointer.
        Dim oPointer As Object
        If Not IsMissing( iButtonPointer ) And iButtonPointer > 0 And iButtonPointer < 72 Then
            oPointer = CreateUnoService( "com.sun.star.awt.Pointer" )
            oPointer.setType( iButtonPointer )
        End If

    REM Style all Buttons:
        If IsMissing( dButtonZoom ) Then dButtonZoom = 1.0
        Dim aButtons()    : aButtons = oMsgBox.getWindows()
        Dim bHasFontDescriptor As Boolean  :  bHasFontDescriptor = Not IsMissing( rButtonFont )
        Dim ub As Integer :  ub = -1  : If Not IsMissing( aButtonLabels ) Then ub = uBound( aButtonLabels )
        Dim i As Integer

        For i = 0 To uBound( aButtons )
            If bHasFontDescriptor Then aButtons( i ).setControlFont( rButtonFont )  REM Button Font.
            If i <= ub Then aButtons( i ).setLabel( aButtonLabels( i ) )            REM Set Buttons Labels.
            If Not IsNull( oPointer ) Then aButtons( i ).setPointer( oPointer )     REM Set Button Pointer.
            aButtons( i ).setZoom( dButtonZoom, dButtonZoom )                       REM Set Button Zoom factor.
        Next i

    REM Create a RichText ControlModel:
        Dim oModel As Object : oModel = createUNOservice( "com.sun.star.form.component.RichTextControl" )       
        oModel.RichText  = True         REM Property valid for RichTextControl, but not for UnoControlEditModel.
        oModel.ReadOnly  = True
        oModel.Multiline = True     
        oModel.FontDescriptor = rTextFieldFont
        oModel.Border    = 0            REM 0=No Border; 1=3D Border; 2=Flat Border; DEFAULT=1.
        'oModel.Align    = 0            REM 0=Left; 1=Center; 2=Right.
        If IsMissing( lDialogBackgroundColor ) Then oModel.BackgroundColor = oMsgBox.StyleSettings.DialogColor Else oModel.BackgroundColor = lDialogBackgroundColor

    REM Format Text Portions:
        Dim aStyleProps()
        Dim aDefaultFont(0) As New com.sun.star.beans.PropertyValue
        aDefaultFont(0).Name = "FontDescriptor"
        aDefaultFont(0).Value = rTextFieldFont
        Dim oTextRange As Object
        Dim aTextPortions() As String  :  aTextPortions = Split( strText, strTextPortionSeparator )
        ub = -1  :  If Not IsMissing( aTextPortionStyleProperties ) Then ub = uBound( aTextPortionStyleProperties )
        For i = 0 To uBound( aTextPortions )
            If i <= ub Then
                If isArray( aTextPortionStyleProperties( i ) ) And uBound( aTextPortionStyleProperties( i ) ) > -1 Then
                    aStyleProps = aTextPortionStyleProperties( i )
                Else
                    aStyleProps = aDefaultFont
                End If
            Else
                aStyleProps = aDefaultFont
            End If
            oTextRange = oModel.appendTextPortion( aTextPortions( i ), aStyleProps )    REM An invalid property name/value causes an Error here.
        Next

    REM Create a RichTextControl:
        Dim oCtrl As Object  : oCtrl = createUNOservice( "com.sun.star.form.control.RichTextControl" )
        oCtrl.setModel( oModel )
        oCtrl.createPeer( oToolKit, oMsgBox )       REM Add the RichTextControl to our MessageBox.
        oCtrl.setPosSize( 47, 7, lTextFieldWidth, lTextFieldHeight, com.sun.star.awt.PosSize.POSSIZE ) REM 47 is our marker!

    REM Set Dialog Position.
        Dim iPosition As Integer: iPosition = 0
        If Not IsMissing( lDialogPositionX ) Then iPosition = iPosition + com.sun.star.awt.PosSize.X
        If Not IsMissing( lDialogPositionY ) Then iPosition = iPosition + com.sun.star.awt.PosSize.Y
        If iPosition > 0 Then oMsgBox.setPosSize( lDialogPositionX, lDialogPositionY, 0, 0, iPosition ) REM Setting the Size doesn't work here, only the Position.

    REM Setting Dialog Size and repositioning the Dialog Controls:
        REM Dialog Size, Control Size, and Control Position are automatically recomputed by the XMessagBox.execute() function, so we won't set them here.
        REM Instead we use a TopWindowListener to grab our Messagebox at the moment it is executed, and then we shall do the final resizing and repositioning of the controls.

    REM Execute MessageBox Dialog.  
        Dim oTopWindowListener As Object
        oTopWindowListener = createUnoListener( "MessageBox_", "com.sun.star.awt.XTopWindowListener" )
        oToolkit.addTopWindowListener( oTopWindowListener )     REM 8 TopWindowListener Callback methods must be defined outside of this Function.
        g_MessageBox = oMsgBox      REM NB.  <Global g_MessageBox As Object>  must be defined outside of this Function.

        MessageBox = oMsgBox.execute()
        oMsgBox.dispose()

        g_MessageBox = Nothing
        oToolkit.removeTopWindowListener( oTopWindowListener )
    End If

REM *********************************** END of MessageBox()
REM **** Needs the following TopWindowListener callback methods:
End Function

REM ******* TopWindowListener callback methods:
Function MessageBox_windowOpened( oEvent As Object )
REM Called from the WindowListener registered in the MessageBox() function.
    If Not IsNull( oEvent ) Then                REM oEvent.Source is NULL !
        If Not IsNull( g_MessageBox ) Then      REM Using Global g_MessageBox instead.
            On Local Error Resume Next
            Dim oContext    As Object  : oContext    = g_MessageBox.getAccessibleContext()
            Dim iChildCount As Integer : iChildCount = oContext.getAccessibleChildCount()
            Dim oChild      As Object
            Dim rPosSize    As New com.sun.star.awt.Rectangle
            Dim rSize       As New com.sun.star.awt.Size
            Dim ub As Integer
            Dim  i As Integer
            Dim lMinX As Long, lMaxX As Long, lMinY As Long, lMaxY As Long
            Dim lButtonWidth As Long, lButtonHeight As Long
            Dim lIconAreaWidth As Long  : lIconAreaWidth = 42
            Dim aControls(2) As Integer : aControls(1)   = -1
            Dim aButtons()  As Integer

            Const lMargin   As Long = 7

        REM Identify Accessible controls:
        REM Unfortunately getAccessibleRole(), getAccessibleName(), and getAccessibleDescription() do not seem to work here,
        REM So we have to identify the controls by their position, size, etc.
        REM 0=RichText ; 1=icon ; 2=Edit ; 3 to last =Buttons.
            For i = 0 To iChildCount - 1
                oChild   = oContext.getAccessibleChild( i )
                rPosSize = oChild.getPosSize()

                If rPosSize.X = 47 And rPosSize.Y = 7 Then      REM assume our RichText control.
                    aControls(0) = i
                ElseIf rPosSize.Y = 7 Then                      REM assume built-in Edit control.
                    aControls(2) = i
                ElseIf rPosSize.Height = rPosSize.Width Then    REM assume icon.
                    aControls(1) = i
                Else                                            REM assume Buttons.
                    ub = uBound( aButtons ) + 1
                    ReDim Preserve aButtons( ub )
                    aButtons( ub ) = i
                End If
            Next i
            If aControls(1) = -1 Then lIconAreaWidth = 0

        REM Get the size of our inserted RichText control:
            oChild   = oContext.getAccessibleChild( aControls(0) )
            rSize    = oChild.getSize()     REM pos = {47,7}
            Dim lRequestedWidth  As Long :  lRequestedWidth  = rSize.Width
            Dim lRequestedHeight As Long :  lRequestedHeight = rSize.Height
            oChild.setPosSize( lIconAreaWidth + lMargin, lMargin, 0, 0, com.sun.star.awt.PosSize.POS )

        REM The icon:
        '   If aControls(1) > -1 Then oChild = oContext.getAccessibleChild( aControls(1) )

        REM Disable the built-in Message field:
            oChild   = oContext.getAccessibleChild( aControls(2) )  
            oChild.setEnable( False )

        REM Get First Button dimensions.
            oChild   = oContext.getAccessibleChild( aButtons(0) )
            rPosSize = oChild.getPosSize()
            lButtonWidth  = rPosSize.Width
            lButtonHeight = rPosSize.Height
            lMinX = rPosSize.X  :  lMaxX = rPosSize.X
            lMinY = rPosSize.Y  :  lMaxY = rPosSize.Y

        REM Get Button Area dimensions:
            For i = 1 To uBound( aButtons )
                oChild  = oContext.getAccessibleChild( aButtons( i ) )
                rPosSize = oChild.getPosSize()
                If rPosSize.X < lMinX Then lMinX = rPosSize.X
                If rPosSize.X > lMaxX Then lMaxX = rPosSize.X
                If rPosSize.Y < lMinY Then lMinY = rPosSize.Y
                If rPosSize.Y > lMaxY Then lMaxY = rPosSize.Y
            Next i

        REM Adjust Dialog dimensions:
            Dim lButtonAreaWidth As Long :  lButtonAreaWidth = ( uBound( aButtons ) + 1 ) * ( lButtonWidth + lMargin ) - lMargin
            Dim lDialogHeight As Long    :  lDialogHeight = lRequestedHeight + lButtonHeight + lMargin * 3
            Dim lDialogWidth  As Long    :  lDialogWidth  = lRequestedWidth + lIconAreaWidth + lMargin * 2
            If  lDialogWidth < lButtonAreaWidth + lMargin * 2  Then  lDialogWidth = lButtonAreaWidth + lMargin * 2
            rSize.Width  = lDialogWidth
            rSize.Height = lDialogHeight
            g_MessageBox.setOutputSize( rSize )

        REM Reposition Buttons:
            Dim lNewX As Long, lNewY As Long
            Dim iButtonAreaStart As Integer : iButtonAreaStart = ( lDialogWidth - lButtonAreaWidth ) / 2
            lNewY = lRequestedHeight + lMargin * 2
            For i = 0 To uBound( aButtons )
                oChild  = oContext.getAccessibleChild( aButtons( i ) )
                lNewX  = iButtonAreaStart + i * ( lButtonWidth + lMargin )
                oChild.setPosSize( lNewX, lNewY, 0, 0, com.sun.star.awt.PosSize.POS )
            Next i

        End If
    End If
End Function
Function MessageBox_windowClosing( oEvent As Object )
End Function
Function MessageBox_windowClosed( oEvent As Object )
End Function
Function MessageBox_windowMinimized( oEvent As Object )
End Function
Function MessageBox_windowNormalized( oEvent As Object )
End Function
Function MessageBox_windowActivated( oEvent As Object )
End Function
Function MessageBox_windowDeactivated( oEvent As Object )
End Function
Function MessageBox_disposing( oEvent As Object )
End Function
REM **** END of TopWindowListener callback methods.

Hope you can use it,

with regards, lib