MsgBox format 7

[deepsheep]

I have a msgbox in a VB6 application that is doing what I want. It displays a message and stays on top of everything (by vbSystemModal option) until the 'OK' is pressed.

However, I want the text to be bigger in the msgBox. I want it to be big enough that if someone wanders past the screen, they can read it easily.

I tried changing the font size on the form and it didn't work.

Any ideas?
Thanks!

 

[HughLerwill]

phew!

 

[BobRodes]

<Why I get 29 debug prints instead of 1 I'm not quite sure yet, but that's a side issue

Interesting...SetWindowPos fires the CBT hook a bunch of times.

 

[BobRodes]

So when I put SetWindowPos after UnhookWindowsHookEx that doesn't happen anymore.

 

[BobRodes]

strongm, I've been examining your VbGetTextWidth code that is in the thread you posted. I found that if I'm using my IFont object reference as the input to your Font argument, its properties get messed up by changing myFont.Size, even if I change it back again. I solved it by cloning a new IFont object to decouple the reference, and messing with the clone's Size property instead. Here's the mod:

[COLOR=blue]Public Function vbGetTextWidth(ByVal strSource As String, Font As IFont) As Long
Dim myClone As IFont
Dim hFont As Long
Dim mySize As SIZE
Dim hdc As Long

myFont.Clone myClone  ' clone a copy using the IFont interface's Clone method
myClone.SIZE = Font.SIZE * 1000 ' increases accuracy since resultant mysize only hold longs

hdc = CreateCompatibleDC(0) ' compatible with screen display
hFont = SelectObject(hdc, myClone.hFont)
GetTextExtentPoint32 hdc, strSource, Len(strSource), mySize

'Clean up as much as we need to
SelectObject hdc, hFont
DeleteDC hdc

vbGetTextWidth = mySize.cX / 1000 ' bring back to normal
End Function
[/color]

Also, I didn't need to pass in "Font as StdFont" and then polymorph to the IFont interface, as I was already using an IFont interface. So I left out that step.

Onward and upward...

 

[strongm]

Now that's odd. The code I've got here on my PC (dating back to the middle of 2004) differs from the example I posted to TT in that thread. The code is:

[blue]
Public Function vbGetTextWidth(ByVal strSource As String, Font As stdOLE.IFont) As Long
    Dim myFont As stdOLE.IFont ' We want the IFont interface
    Dim hFont As Long
    Dim mySize As SIZE
    Dim hdc As Long
    
    Font.Clone myFont ' switch interfac
    myFont.SIZE = Font.SIZE * 1000 ' increases accuracy since resultant mysize only hold longs
    
    hdc = CreateCompatibleDC(0) ' compatible with screen display
    hFont = SelectObject(hdc, myFont.hFont)
    GetTextExtentPoint32 hdc, strSource, Len(strSource), mySize
    
    'Clean up as much as we need to
    SelectObject hdc, hFont
    DeleteDC hdc
    
    vbGetTextWidth = mySize.cx / 1000 ' bring back to normal
End Function[/blue]

which, as you can see, includes both the refinements you have discovered for yourself.

(both the thread I referenced earlier and the code now shown here were derived in turn from my first go at this in thread222-885251, which you'll see itself was a modification of some code from Hypetia)

 

[BobRodes]

Now, this is strange (from a breakpoint in "Wrapper for normal MsgBox function" from strongm's first block of code):

? fbold
False
? myfont.Bold
True
myfont.Bold = False
? myfont.Bold
False
myfont.Bold = fbold
? myfont.Bold
True

Looks like it might be a bug!! This also happens:

? fbold
False
? myfont.Bold
True
myfont.Bold = False
? myfont.Bold
False
myfont.Bold = fbold = True
? myfont.Bold
False

Which looks like a workaround.

 

[strongm]

Just pass fBold ByVal (instead of the lazy default ByRef that I used) to fix that

 

[BobRodes]

From testing some values, it's unfortunately becoming clear that this approach won't tell me exactly when word wrapping will kick in. the same width from example to example. If I put a lot of i's in the text, it tends to stuff them on an existing line, where values of the same width with wider characters will go on the following line. For example, in 8 point Arial, the string "Now is the time for all good men to come to the aid of their country Now is the time for all good men to come to the aid of their country Now is the time for alliiiiiiiiii" (sans quotes) stays on one line (using vbyesno only, no icon), and vbGetTextWidth returns 783. Adding another i to the string causes the last word to wrap, and the return value is 785. On the other hand, the string "Now is the time for all good men to come to the aid of their country Now is the time for all good men to come to the aid of their country Noiiii is the tiiiiiiii for alliiiiiiiiii" returns 786 and stays on one line. Apparently, there's a weighting bias for wide letters when deciding to wrap to the next line.

This is proving to be tough! Anyone got any ideas? I'm trying to determine when this MsgBox will word wrap to the next line, so I can size the window and position the buttons appropriately.

 

[three57m]

Is vbcrlf a viable option bobrodes

 

[strongm]

There are at least a couple of viable solutions for this.

One uses EM_FMTLINES and one uses EM_FORMATRANGE ...

 

[BobRodes]

<Is vbcrlf a viable option bobrodes

Uh oh. I forgot about that; thanks for reminding me. No, not a viable option because the user can put vbcrlf in the prompt. On the other hand, that creates more interesting problems for me, since we'll have to take that into account when sizing the text window.

strongm, I'll have a look at those. Thanks for the suggestion.

Bob

 

[BobRodes]

All right. I spent some time with all of the suggestions for determining the size of a range of formatted text, and didn't find anything that would work perfectly for me. A simpler way to accomplish the requirement would be to allow the user to size the window manually, so that's what I wound up doing. Here's the code, with notes:

[COLOR=blue]'General Note: notes are above the line of code to which they apply.

Option Explicit

' Window size and position constants
Private Const ICON_WIDTH As Integer = 32
Private Const BTN_WIDTH As Integer = 75
Private Const BTN_HEIGHT As Integer = 23
Private Const BTN_SPACER As Integer = 6    ' Space between 2 buttons
Private Const STW_OFFSET As Integer = 12   ' Standard window offset, minimum distance one window can be from
                                           ' the edge of its container
                                           
' SendMessage constants that we will use
Private Const WM_SETFONT = &H30
Private Const WM_GETTEXT = &HD

' Necessary constants  for hooking
Private Const HCBT_CREATEWND = 3
Private Const HCBT_ACTIVATE = 5
Private Const WH_CBT = 5

' Working variables that require global scope in hooking module
Private hHook As Long
Private myFont As IFont
Private cPrompt As String
Private hwndStatic As Long
Private ButtonHandles() As Long
Private xPixels As Long
Private yPixels As Long
Private isIcon As Boolean

' The API declarations we need
Private Type SIZE
    cx As Long
    cy As Long
End Type

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
'GETTEXT needs a String argument, SETFONT needs an Any argument, hence 2 declarations for SendMessage
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function SendMessageS Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long

' Wrapper for the normal MsgBox function
Public Function myMsgBox(Prompt As String, Buttons As VbMsgBoxStyle, ByVal fSize As Integer, ByVal fBold As Boolean, ByVal fItalic As Boolean, ByVal fULine As Boolean, fFaceName As String, Optional Title As String, Optional HelpFile As String, Optional Context As Long, Optional x As Long, Optional y As Long) As Long
'x and y arguments are optional and are in twips.  If not specified, msgbox will use default window sizes
'and positions, which work fine if you are using default font sizes.  If you aren't they may not.
cPrompt = Prompt
Set myFont = New StdFont
myFont.SIZE = fSize ' We can play around with the font to our heart's content here, all in a VB-friendly way
myFont.Bold = fBold
myFont.Italic = fItalic
myFont.Underline = fULine
myFont.Name = fFaceName
'Convert x and y arguments to pixels from twips.  (Twips are the same size no matter what the screen
'resolution; pixels aren't.)
If Not IsMissing(x) Then
    xPixels = Int(x / Screen.TwipsPerPixelX)
End If
If Not IsMissing(y) Then
    yPixels = Int(y / Screen.TwipsPerPixelY)
End If
hHook = SetWindowsHookEx(WH_CBT, AddressOf CBTProc, App.hInstance, 0)
'This will call CBTProc, passing the handle of the MsgBox window to the wParam argument.
myMsgBox = MsgBox(Prompt, Buttons, Title, HelpFile, Context)
End Function

Private Function CBTProc(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim i As Integer
Dim statX As Integer   'X dimension of static (text) window
Dim statY As Integer   'Y dimension of same
Dim cLeft As Integer   'Current Left value for current button, used to position buttons along x axis
Dim rc As RECT          'Used with GetClientRect
If lMsg = HCBT_ACTIVATE Then
    'Immediately unhook (we have the handle we're looking for, and don't want to fire any more CBT events)
    UnhookWindowsHookEx hHook
    'Call EnumChildWindowProc once for each window that is contained in the MsgBox
    EnumChildWindows wParam, AddressOf EnumChildWindowProc, 0
    'Reinitialize the static buttoncount variable, see the proc
    EnumChildWindowProc 0, 1
    'Should always be true, but this prevents an abend if for some reason we fail to get the text window
    If hwndStatic Then
        'If the x parameter has been supplied to the main wrapper, then xPixels <> 0
        If xPixels Then
            With Screen
                'Center the MsgBox window in the screen
                SetWindowPos wParam, 0, (.Width / .TwipsPerPixelX - xPixels) / 2, _
                            (.Height / .TwipsPerPixelY - yPixels) / 2, xPixels, yPixels, 0
            End With
            'Analogous to the ScaleWidth and ScaleHeight properties.  Client rectangle's dimensions are
            'returned to the rc type and exclude the dimensions of the title bar and the borders.
            GetClientRect wParam, rc
            'Calculate x and y values for text window.  If there's an icon, we need to reduce the size of the
            'text window by the width of the icon plus a standard offset value.
            statX = rc.Right - rc.Left - STW_OFFSET * 2 - ((isIcon And 1) * (ICON_WIDTH + STW_OFFSET))
            statY = rc.Bottom - rc.Top - BTN_HEIGHT - STW_OFFSET * 2
            'We need to position the text window along the x axis such that it's a standard offset from the left
            'border of the msgbox, plus the width of the icon and another standard offset if the icon exists.
            SetWindowPos hwndStatic, 0, STW_OFFSET + (isIcon And 1) * (ICON_WIDTH + STW_OFFSET), STW_OFFSET, statX, statY, 0
            isIcon = 0
            'Loop through the button handles, calculating the left border position each time.
            For i = 0 To UBound(ButtonHandles)
                'Current left border is half the container window's width, less the width of half the total
                'number of buttons, plus the offset of the current button in the array.
                cLeft = Int(xPixels / 2 + BTN_WIDTH * (i - (UBound(ButtonHandles) + 1) / 2))
                'Modify the above to add button spacer widths.
                cLeft = cLeft + BTN_SPACER * (i - (UBound(ButtonHandles) - 1) + (UBound(ButtonHandles) Mod 2) / 2)
                'The Y value is 1 standard offset more than the height of the text window.
                SetWindowPos ButtonHandles(i), 0, cLeft, statY + STW_OFFSET, BTN_WIDTH, BTN_HEIGHT, 0
            Next
        End If
        SendMessage hwndStatic, WM_SETFONT, myFont.hFont, True
    End If
End If
CBTProc = 0 ' allow operation to continue
End Function

Private Function EnumChildWindowProc(ByVal hChild As Long, ByVal lParam As Long) As Long
Static ButtonCount As Integer
Dim sLen As Integer
Dim wClass As String
Dim wText As String
Dim rc As RECT
If lParam Then
    ButtonCount = 0     'See the direct call of this proc in CBTProc: resets the ButtonCount variable to 0
    Exit Function
End If
wClass = String(64, 0)
'look up the type of the current window
sLen = GetClassName(hChild, wClass, 63)
wClass = Left(wClass, sLen)
'We have either one or two static windows: optionally the icon (the first window if it's there) and the
'text window (analogous to a label control).
If wClass = "Static" Then
    'If we already have the text window's handle, we don't need to do this anymore.
    If Not hwndStatic Then
        'Find out if the current window's text value is the same as the text passed in to the cPrompt
        'argument in the main wrapper function.  If it is, it's the text window and we store the handle
        'value in hwndStatic.  If it isn't, then it's an icon and we set the isIcon flag.
        wText = String(Len(cPrompt) + 1, 0)
        sLen = SendMessageS(hChild, WM_GETTEXT, 255, wText)
        wText = Left(wText, sLen)
        If wText = cPrompt Then
            hwndStatic = hChild
        Else
            isIcon = True
        End If
    End If
ElseIf wClass = "Button" Then
    'Store the button's handle in the ButtonHandles array
    ReDim Preserve ButtonHandles(ButtonCount)
    ButtonHandles(ButtonCount) = hChild
    ButtonCount = ButtonCount + 1
End If
EnumChildWindowProc = 1  ' Continue enumeration
End Function
[/color]

So, all in all, it's a lot easier to create your own form and use it as a message box. But it doesn't have the same pedagogical value. Thanks to strongm for the pointers along the way. I've learned a good deal about the Windows API.

Bob