Reputation: 20474
Is there an easy way to display a custom font for a MessageBox?
For "easy way" I mean using WinAPI or other techniques but not coding a entire messagebox from scratch.
I've seen lots of custom messagebox but most are just forms which don't preserve default messagebox additional parametters, other custom messagebox just has their size/bounds wrong so the "ok" button is cutted or not right alligned, and other custom messagebox has their own problems/bugs.
I hope if is possibly to add a generic parametter to instance this great custom messagebox setting the desired font:
The original code is a C# custom messagebox class of @Hans Passant which I've taken a lot time ago from here Winforms-How can I make MessageBox appear centered on MainForm? and translated it using an online translator:
' [ Centered Messagebox ]
'
' Examples :
'
' Using New MessageBox_Centered(Me)
' MessageBox.Show("Test Text", "Test Title", MessageBoxButtons.OK)
' End Using
#Region " Centered MessageBox Class"
Imports System.Runtime.InteropServices
Imports System.Text
Class MessageBox_Centered
Implements IDisposable
' P/Invoke
Public Class NativeMethods
Delegate Function EnumThreadWndProc(hWnd As IntPtr, lp As IntPtr) As Boolean
<DllImport("user32.dll")> _
Shared Function EnumThreadWindows(tid As Integer, callback As EnumThreadWndProc, lp As IntPtr) As Boolean
End Function
<DllImport("kernel32.dll")> _
Shared Function GetCurrentThreadId() As Integer
End Function
<DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Unicode)> _
Shared Function GetClassName(hWnd As IntPtr, buffer As StringBuilder, buflen As Integer) As Integer
End Function
<DllImport("user32.dll")> _
Shared Function GetWindowRect(hWnd As IntPtr, ByRef rc As RECT) As Boolean
End Function
<DllImport("user32.dll")> _
Shared Function MoveWindow(hWnd As IntPtr, x As Integer, y As Integer, w As Integer, h As Integer, repaint As Boolean) As Boolean
End Function
Structure RECT
Public Left As Integer
Public Top As Integer
Public Right As Integer
Public Bottom As Integer
End Structure
End Class
Private mTries As Integer = 0
Private mOwner As Form
Public Sub New(owner As Form)
mOwner = owner
owner.BeginInvoke(New MethodInvoker(AddressOf findDialog))
End Sub
Private Sub findDialog()
' Enumerate windows to find the message box
If mTries < 0 Then Return
Dim callback As New NativeMethods.EnumThreadWndProc(AddressOf checkWindow)
If NativeMethods.EnumThreadWindows(NativeMethods.GetCurrentThreadId(), callback, IntPtr.Zero) Then
If System.Threading.Interlocked.Increment(mTries) < 10 Then
mOwner.BeginInvoke(New MethodInvoker(AddressOf findDialog))
End If
End If
End Sub
Private Function checkWindow(hWnd As IntPtr, lp As IntPtr) As Boolean
' Checks if <hWnd> is a dialog
Dim sb As New StringBuilder(260)
NativeMethods.GetClassName(hWnd, sb, sb.Capacity)
If sb.ToString() <> "#32770" Then Return True
' Got it
Dim frmRect As New Rectangle(mOwner.Location, mOwner.Size)
Dim dlgRect As NativeMethods.RECT
NativeMethods.GetWindowRect(hWnd, dlgRect)
NativeMethods.MoveWindow(hWnd, frmRect.Left + (frmRect.Width - dlgRect.Right + dlgRect.Left) \ 2, frmRect.Top + (frmRect.Height - dlgRect.Bottom + dlgRect.Top) \ 2, dlgRect.Right - dlgRect.Left, dlgRect.Bottom - dlgRect.Top, True)
Return False
End Function
Public Sub Dispose() Implements IDisposable.Dispose
mTries = -1
End Sub
End Class
#End Region
UPDATE:
Trying to adapt @Pete supposed solution just I can't do it.
Class MessageBox_Centered : Implements IDisposable
Public Class NativeMethods
Delegate Function EnumThreadWndProc(hWnd As IntPtr, lp As IntPtr) As Boolean
Delegate Function EnumWindowsProc(hWnd As IntPtr, lp As IntPtr) As Boolean
<DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)> _
Shared Function EnumThreadWindows(tid As Integer, callback As EnumThreadWndProc, lp As IntPtr) As Boolean
End Function
<DllImport("kernel32.dll", SetLastError:=True, CharSet:=CharSet.Auto)> _
Shared Function GetCurrentThreadId() As Integer
End Function
<DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)> _
Shared Function GetClassName(hWnd As IntPtr, buffer As StringBuilder, buflen As Integer) As Integer
End Function
<DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)> _
Shared Function GetWindowRect(hWnd As IntPtr, ByRef rc As RECT) As Boolean
End Function
<DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)> _
Shared Function MoveWindow(hWnd As IntPtr, x As Integer, y As Integer, w As Integer, h As Integer, repaint As Boolean) As Boolean
End Function
<DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)> _
Shared Function GetWindowText(ByVal hwnd As IntPtr, ByVal lpString As StringBuilder, ByVal cch As Integer) As Integer
End Function
<DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)> _
Shared Function EnumChildWindows(hwndParent As IntPtr, lpEnumFunc As EnumWindowsProc, lParam As IntPtr) As <MarshalAs(UnmanagedType.Bool)> Boolean
End Function
<DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)> _
Shared Function SendMessage(hWnd As IntPtr, Msg As UInt32, wParam As IntPtr, lParam As IntPtr) As IntPtr
End Function
Structure RECT
Public Left As Integer
Public Top As Integer
Public Right As Integer
Public Bottom As Integer
End Structure
End Class
Private mTries As Integer = 0
Private mOwner As Form
Public Sub New(owner As Form)
mOwner = owner
owner.BeginInvoke(New MethodInvoker(AddressOf findDialog))
End Sub
Private Sub findDialog()
' Enumerate windows to find the message box
If mTries < 0 Then Return
Dim callback As New NativeMethods.EnumThreadWndProc(AddressOf checkWindow)
If NativeMethods.EnumThreadWindows(NativeMethods.GetCurrentThreadId(), callback, IntPtr.Zero) Then
If System.Threading.Interlocked.Increment(mTries) < 10 Then
mOwner.BeginInvoke(New MethodInvoker(AddressOf findDialog))
End If
End If
End Sub
Private Function checkWindow(hWnd As IntPtr, lp As IntPtr) As Boolean
' Checks if <hWnd> is a dialog
Dim sb As New StringBuilder(260)
NativeMethods.GetClassName(hWnd, sb, sb.Capacity)
If sb.ToString() <> "#32770" Then
Return True
End If
' Got it
Dim frmRect As New Rectangle(mOwner.Location, mOwner.Size)
Dim dlgRect As NativeMethods.RECT
NativeMethods.GetWindowRect(hWnd, dlgRect)
NativeMethods.MoveWindow(hWnd, frmRect.Left + (frmRect.Width - dlgRect.Right + dlgRect.Left) \ 2, frmRect.Top + (frmRect.Height - dlgRect.Bottom + dlgRect.Top) \ 2, dlgRect.Right - dlgRect.Left, dlgRect.Bottom - dlgRect.Top, True)
' Dim wndText As New StringBuilder()
' NativeMethods.GetWindowText(hWnd2, wndText, 1000)
' SendMessage(hWnd2, WM_SETFONT, f.ToHfont(), new IntPtr(1))
Return False
End Function
Public Sub Dispose() Implements IDisposable.Dispose
mTries = -1
End Sub
End Class
UPDATE 2:
This is an explanation of what I need to do.
Taking the code snippet of @Hans Passant, the centered messagebox, I need to launch it (instance it) but with a custom font.
An example could be creating a generic function into the Centered Messagebox maybe using the "new" block of the Class to pass the desired font as an argument then do the necessary things with that font to show the messagebox centered + with a custom font.
So what I need is to extend the class by adding the possibility of using custom fonts.
Upvotes: 3
Views: 14113
Reputation: 20474
Here is the code!
It has the font-size problem which I need to resolve but by now this is solved!
' The author of this code is Hand Passant:
' http://stackoverflow.com/questions/2259027/bold-text-in-messagebox/2259213#2259213
'
' I've just translated it to VB.NET and made very little modifications.
Imports System.Drawing
Imports System.Runtime.InteropServices
Imports System.Text
Imports System.Windows.Forms
Class CustomMessageBox : Implements IDisposable
Private mTries As Integer = 0
Private mOwner As Form
Private mFont As Font
' P/Invoke declarations
Private Const WM_SETFONT As Integer = &H30
Private Const WM_GETFONT As Integer = &H31
Private Delegate Function EnumThreadWndProc(hWnd As IntPtr, lp As IntPtr) As Boolean
<DllImport("user32.dll")> _
Private Shared Function EnumThreadWindows(tid As Integer, callback As EnumThreadWndProc, lp As IntPtr) As Boolean
End Function
<DllImport("kernel32.dll")> _
Private Shared Function GetCurrentThreadId() As Integer
End Function
<DllImport("user32.dll")> _
Private Shared Function GetClassName(hWnd As IntPtr, buffer As StringBuilder, buflen As Integer) As Integer
End Function
<DllImport("user32.dll")> _
Private Shared Function GetDlgItem(hWnd As IntPtr, item As Integer) As IntPtr
End Function
<DllImport("user32.dll")> _
Private Shared Function SendMessage(hWnd As IntPtr, msg As Integer, wp As IntPtr, lp As IntPtr) As IntPtr
End Function
<DllImport("user32.dll")> _
Shared Function GetWindowRect(hWnd As IntPtr, ByRef rc As RECT) As Boolean
End Function
<DllImport("user32.dll")> _
Shared Function MoveWindow(hWnd As IntPtr, x As Integer, y As Integer, w As Integer, h As Integer, repaint As Boolean) As Boolean
End Function
Structure RECT
Public Left As Integer
Public Top As Integer
Public Right As Integer
Public Bottom As Integer
End Structure
Public Sub New(owner As Form, Optional Custom_Font As Font = Nothing)
mOwner = owner
mFont = Custom_Font
owner.BeginInvoke(New MethodInvoker(AddressOf findDialog))
End Sub
Private Sub findDialog()
' Enumerate windows to find the message box
If mTries < 0 Then
Return
End If
Dim callback As New EnumThreadWndProc(AddressOf checkWindow)
If EnumThreadWindows(GetCurrentThreadId(), callback, IntPtr.Zero) Then
If System.Threading.Interlocked.Increment(mTries) < 10 Then
mOwner.BeginInvoke(New MethodInvoker(AddressOf findDialog))
End If
End If
End Sub
Private Function checkWindow(hWnd As IntPtr, lp As IntPtr) As Boolean
' Checks if <hWnd> is a dialog
Dim sb As New StringBuilder(260)
GetClassName(hWnd, sb, sb.Capacity)
If sb.ToString() <> "#32770" Then Return True
' Got it, get the STATIC control that displays the text
Dim hText As IntPtr = GetDlgItem(hWnd, &HFFFF)
Dim frmRect As New Rectangle(mOwner.Location, mOwner.Size)
Dim dlgRect As RECT
GetWindowRect(hWnd, dlgRect)
MoveWindow(hWnd, frmRect.Left + (frmRect.Width - dlgRect.Right + dlgRect.Left) \ 2, frmRect.Top + (frmRect.Height - dlgRect.Bottom + dlgRect.Top) \ 2, dlgRect.Right - dlgRect.Left, dlgRect.Bottom - dlgRect.Top, True)
If hText <> IntPtr.Zero Then
If mFont Is Nothing Then
' Get the current font
mFont = Font.FromHfont(SendMessage(hText, WM_GETFONT, IntPtr.Zero, IntPtr.Zero))
End If
SendMessage(hText, WM_SETFONT, mFont.ToHfont(), New IntPtr(1))
End If
' Done
Return False
End Function
Public Sub Dispose() Implements IDisposable.Dispose
mTries = -1
mOwner = Nothing
If mFont IsNot Nothing Then mFont.Dispose()
End Sub
End Class
Usage:
Using New CustomMessageBox(Me, New Font(New FontFamily("Lucida Console"), Font.SizeInPoints, FontStyle.Bold))
MessageBox.Show("Test Text", "Test Title", MessageBoxButtons.OK)
End Using
Upvotes: 0
Reputation: 941990
I already answered this question, the answer is here. You just need to tweak is slightly since you are not interested in changing the existing font:
if (hText != IntPtr.Zero) {
// Get the current font
IntPtr hFont = SendMessage(hText, WM_GETFONT, IntPtr.Zero, IntPtr.Zero);
Font font = Font.FromHfont(hFont);
mFont = new Font(new FontFamily("Arial"), font.SizeInPoints, FontStyle.Normal);
SendMessage(hText, WM_SETFONT, mFont.ToHfont(), (IntPtr)1);
}
Only the 5th line is different. Change the font family you want. The same basic problem with this code, although not nearly as severe, the new font you pick must fit the calculated size of the static control. A calculation that was made for the original font. If your new font is "wide" then it won't fit, reducing the SizeInPoints is the only workaround.
Upvotes: 3
Reputation: 6743
First of all, I apologize for my answer not being in VB (Update - Ran the code through a C# to VB converter). Surely you can read C# well enough to make sense of this and I will happily answer any questions you have about it.
This solution is not generic, in terms of how you go about finding the window and the static control. You'll need to adapt it to your own situation, but the important piece about how to set the font is reusable.
The Thread.Sleep()
at the beginning of the thread is a little arbitrary. You'll probably want to wait a bit (a half second is surely too long), but it will take time for the message box to be displayed and the message box will block execution. So, I fire off the thread, have it wait until the message box is definitely open, and then I start looking for it.
Also, be sure to call DeleteObject()
on the HFont eventually.
Public Partial Class Form1
Inherits Form
Private Const WM_SETFONT As UInt32 = &H30
Private Delegate Function EnumThreadDelegate(hwnd As IntPtr, lParam As IntPtr) As Boolean
Private Delegate Function EnumWindowsProc(hWnd As IntPtr, lParam As IntPtr) As Boolean
<DllImport("user32.dll")> _
Private Shared Function EnumThreadWindows(dwThreadId As UInteger, lpfn As EnumThreadDelegate, lParam As IntPtr) As <MarshalAs(UnmanagedType.Bool)> Boolean
End Function
<DllImport("kernel32.dll")> _
Private Shared Function GetCurrentThreadId() As UInteger
End Function
<DllImport("user32.dll", SetLastError := True, CharSet := CharSet.Auto)> _
Private Shared Function GetClassName(hWnd As IntPtr, lpClassName As StringBuilder, nMaxCount As Integer) As Integer
End Function
<DllImport("user32.dll")> _
Private Shared Function EnumChildWindows(hwndParent As IntPtr, lpEnumFunc As EnumWindowsProc, lParam As IntPtr) As <MarshalAs(UnmanagedType.Bool)> Boolean
End Function
<DllImport("user32.dll", CharSet := CharSet.Auto, SetLastError := True)> _
Private Shared Function GetWindowText(hWnd As IntPtr, lpString As StringBuilder, nMaxCount As Integer) As Integer
End Function
<DllImport("user32.dll", CharSet := CharSet.Auto)> _
Private Shared Function SendMessage(hWnd As IntPtr, Msg As UInt32, wParam As IntPtr, lParam As IntPtr) As IntPtr
End Function
Shared threadId As UInteger = GetCurrentThreadId()
Public Sub New()
InitializeComponent()
End Sub
Private Sub button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim t As New Thread(New ThreadStart(AddressOf FixMsgBoxFont))
t.Start()
MessageBox.Show(Me, "MyMsg", "Test")
End Sub
Private Sub FixMsgBoxFont()
Thread.Sleep(500)
EnumThreadWindows(threadId, New EnumThreadDelegate(Function(hWnd, lParam)
Dim className As New StringBuilder()
GetClassName(hWnd, className, 1000)
' Look for the message box window
If className.ToString() <> "#32770" Then
Return True
End If
EnumChildWindows(hWnd, New EnumWindowsProc(Function(hWnd2, lParam2)
Dim wndText As New StringBuilder()
GetWindowText(hWnd2, wndText, 1000)
' Look for the static control with our text
If wndText.ToString() = "MyMsg" Then
' Replace the font being used with 8pt Comix Sans MS
Dim f As New Font(New FontFamily("Comic Sans MS"), 8, FontStyle.Bold, GraphicsUnit.Pixel)
' In real life, you'll eventually want to eventually call
' the Windows API DeleteObject() on the font handle
' below or it will leak.
Dim fontHandle As IntPtr = f.ToHfont()
SendMessage(hWnd2, WM_SETFONT, f.ToHfont(), New IntPtr(1))
Return False
End If
Return True
End Function), IntPtr.Zero)
Return False
End Function), IntPtr.Zero)
End Sub
End Class
Upvotes: 1