center justify MsgBox text?

[softwareguy74]

Is it possible to center justify MsgBox text? If so, what is the correct vb code to do so?

Thanks,

Dan

[MartinLiss]

One way (and perhaps the only way) is to create a form that looks like a MessageBox and then you can do anything you want with it. I say "perhaps" because my nevers and onlys have sometimes been proven wrong by some people like Aaron Young and Yonatin who know the APIs much better than I do.

[QWERTY]

We were trying (with my vb-friends) to achieve this goal and we couldn't get anywhere. We also talked to MS vb-tech support and after few days (and a lot of $$$ spent by us) he couldn't find a way to do it (and according to him he was doing vb since first version). Finally we got mad and we created our own msgbox (like Martin said). We have a function to show the msgbox. It looks exactly the same as the real msgbox, except it is much better.
So go with Martin's advice - create a new msgbox.

[Aaron Young]

As Martin mentioned my name I thought I should at least give this a go and here's the result:

In a Module...

Option Explicit

Private Type CWPSTRUCT
        lParam As Long
        wParam As Long
        message As Long
        hwnd As Long
End Type

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

Private Type POINTAPI
        X As Long
        Y As Long
End Type

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
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 CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam 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 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 GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As POINTAPI) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long

Private Const WH_CALLWNDPROC = 4
Private Const GWL_WNDPROC = (-4)

Private Const WM_CTLCOLORSTATIC = &H138
Private Const WM_DESTROY = &H2
Private Const WM_CREATE = &H1

Private lHook As Long
Private lPrevWnd As Long
Private sMsg As String

Public Function SubMsgBox(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim tRECT As RECT
    Dim tSIZE As POINTAPI
    Dim sText As String
    Dim vLines As Variant
    Dim lLine As Long
    Dim lOffSet As Long
    
    Select Case Msg
    Case WM_CTLCOLORSTATIC
        '>>> Center the Messagebox Text, Only if it has no Icon/Image in it
        If Len(sMsg) = 0 Then
            
            'First get the Text that's going to be displayed and calculate it's width in Pixels.
            sText = Space(256)
            sText = Left(sText, GetWindowText(lParam, ByVal sText, 256))
            
            'Split the Text into it Individual Lines (if there are multiple lines)
            vLines = Split(sText, vbCrLf)
            
            'Get the Bounding Rectangle of the Static Control (Label)
            Call GetWindowRect(lParam, tRECT)
            
            'Now Enumerate the Line(s) padding each with spaces until it's centered
            For lLine = 0 To UBound(vLines)
                sText = vLines(lLine)
                Call GetTextExtentPoint32(wParam, ByVal sText, Len(sText), tSIZE)
                lOffSet = tSIZE.X + (((tRECT.Right - tRECT.Left) - tSIZE.X) / 2)
                While tSIZE.X < lOffSet
                    sText = " " & sText
                    Call GetTextExtentPoint32(wParam, ByVal sText, Len(sText), tSIZE)
                Wend
                If tSIZE.X > lOffSet Then sText = Mid(sText, 2)
                vLines(lLine) = sText
            Next
            
            'Rebuild the Message Text String
            sText = Join(vLines, vbCrLf) & Chr(0)
            
            'Remember we've done this process
            sMsg = sText
            
            'Set the new "Formatted" message text
            Call SetWindowText(lParam, ByVal sText)
        End If
                
    Case WM_DESTROY
        'Remove the MsgBox Subclassing
        Call SetWindowLong(hwnd, GWL_WNDPROC, lPrevWnd)
    
    End Select
    
    SubMsgBox = CallWindowProc(lPrevWnd, hwnd, Msg, wParam, ByVal lParam)

End Function

Private Function HookWindow(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim tCWP As CWPSTRUCT
    Dim sClass As String
    'This is where you need to Hook the Messagebox
    CopyMemory tCWP, ByVal lParam, Len(tCWP)
    If tCWP.message = WM_CREATE Then
        sClass = Space(255)
        sClass = Left(sClass, GetClassName(tCWP.hwnd, ByVal sClass, 255))
        If sClass = "#32770" Then
            'Subclass the Messagebox as it's created
            lPrevWnd = SetWindowLong(tCWP.hwnd, GWL_WNDPROC, AddressOf SubMsgBox)
        End If
    End If
    HookWindow = CallNextHookEx(lHook, nCode, wParam, ByVal lParam)
End Function

Public Function MsgBoxEx(Prompt, Optional Buttons As VbMsgBoxStyle = vbOKOnly, Optional Title, Optional HelpFile, Optional Context) As VbMsgBoxResult
    Dim lReturn As Long
    
    sMsg = ""
    'Set the Defaults
    If IsEmpty(Title) Then Title = App.Title
            
    'Hook the Thread
    lHook = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf HookWindow, App.hInstance, App.ThreadID)
    
    'Store the Return Value
    MsgBoxEx = MsgBox(Prompt, Buttons, Title, HelpFile, Context)
    
    'Remove the Hook
    Call UnhookWindowsHookEx(lHook)
End Function

Usage:

Private Sub Command1_Click()
    MsgBoxEx "Example of a Messagebox" & vbCrLf & "For Which the Text is Centered" & vbCrLf & vbCrLf & "Done with the API's!"
End Sub

The only limitation is that it wont center when using an Icon in the Message, but if you really want that you can add the extra code to compensate.

[MartinLiss]

As I said, some people know the API's much better than I do, and it seems also better than MS tech support!