There is message box in my calc macro
msgbox(sometext, 48, someothertext)
I want to highlight some part of (sometext) with color or with bold type. For example, I want in
msgbox(“My name is John Roberts”, 48, "Family)
“John” to be bold and “Roberts” to be red color.
How can I do it?
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:
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
4 Likes
On my Windows 10 system (LO 5.4.3.2), the size of rich text (“John” and “Roberts”) is about twice as large as the other text. The positioning of the text is correct, however.
Thanks for the feedback @jimk, unfortunately i have no clue how this difference might be caused, and i lack the means to test it on Windows. As an immediate patch i would suggest adding a CharHeight property with Value=12 to both the aProps1() and aProps2() arrays.
@librebel Thanks for this code. Had same problem as @jimk with height of characters on Linux Mint. Solution was your patch with Value = 11 (both 1 & 2).
YW @Ratslinger, i should really look into that matter of the font sizes…
Without the aforementioned patch, does the problem still occur when you provide a FontDescriptor structure (filled) as the 8th argument to the Messagebox function?
Sorry, not my area. Not sure how to set. Will try to figure it out & test.
yes something is going wrong there with the FontDescriptor… will look into it shortly, thanks for the feedback.
e.g.
Dim rFD as New com.sun.star.awt.FontDescriptor
rFD.Name = "Comic Sans MS"
rFD.Height = 12@librebel Using descriptors from system (tried a few fonts like Ubuntu), the text is all the same height (without the patch) but now the “My name is” portion is in Bold & italics. Will play some more with it tomorrow.
Running with:
Dim rFD as New com.sun.star.awt.FontDescriptor
rFD.Name = "Liberation Serif"
rFD.Height = 12
and no patches, the result looks good. Playing with the height, it only affects the “My name is” portion - this is using your sample at beginning of answer.
There is no way to do that using msgbox.
Thank you. I’m very sorry
Instead of msgbox, create a custom dialog. Use three label controls, one for each different type of formatting.
Thank you, but I don’t want to use dialog for some reason