Example usage:
Using New CenteredMessageBox(Owner:=Me,
TextFont:=Me.Font,
TimeOut:=2500)
MessageBox.Show("Test Text",
"Test Title",
MessageBoxButtons.OK,
MessageBoxIcon.Information)
End Using
The Custom MessageBox:
' [ Centered MessageBox ]
' By Elektro
'
' The author of the original idea is Hans Passant:
' http://stackoverflow.com/questions/2576156/winforms-how-can-i-make-messagebox-appear-centered-on-mainform
'
' Examples :
'
'Using New CenteredMessageBox(Owner:=Me,
' TextFont:=New Font("Lucida Console", Font.SizeInPoints, FontStyle.Bold),
' TimeOut:=2500)
'
' MessageBox.Show("Test Text", "Test Title", MessageBoxButtons.OK, MessageBoxIcon.Information)
'
'End Using
#Region " Centered MessageBox Class"
#Region " Imports "
Imports System.Drawing
Imports System.Runtime.InteropServices
Imports System.Text
Imports System.Windows.Forms
#End Region
Class CenteredMessageBox : Implements IDisposable
#Region " Variables, Objects, Properties "
Private mTries As Integer = 0
Private mOwner As Form
Private mFont As Font
Private mTimeOut As Integer
Private WithEvents TimeoutTimer As Timer
Private ReadOnly Property MessageBoxWindowHandle As IntPtr
Get
Return _MessageBoxWindowHandle
End Get
End Property
Dim _MessageBoxWindowHandle As IntPtr = IntPtr.Zero
#End Region
#Region " P/Invoke "
Friend Class NativeMethods
Friend Const WM_SETFONT As Integer = &H30
Friend Const WM_GETFONT As Integer = &H31
Friend Delegate Function EnumThreadWndProc(hWnd As IntPtr, lp As IntPtr) As Boolean
Friend Declare Function SetWindowPos Lib "user32" (ByVal hwnd As IntPtr, ByVal hWndInsertAfter As IntPtr, ByVal x As Integer, ByVal y As Integer, ByVal cx As Integer, ByVal cy As Integer, ByVal wFlags As UInt32) As Boolean
<DllImport("user32.dll")>
Friend Shared Function EnumThreadWindows(tid As Integer, callback As NativeMethods.EnumThreadWndProc, lp As IntPtr) As Boolean
End Function
<DllImport("kernel32.dll")>
Friend Shared Function GetCurrentThreadId() As Integer
End Function
<DllImport("user32.dll", CharSet:=CharSet.Unicode)>
Friend Shared Function GetClassName(hWnd As IntPtr, buffer As StringBuilder, buflen As Integer) As Integer
End Function
<DllImport("user32.dll")>
Friend Shared Function GetDlgItem(hWnd As IntPtr, item As Integer) As IntPtr
End Function
<DllImport("user32.dll")>
Friend Shared Function SendMessage(hWnd As IntPtr, msg As Integer, wp As IntPtr, lp As IntPtr) As IntPtr
End Function
<DllImport("user32.dll")>
Friend Shared Function GetWindowRect(hWnd As IntPtr, ByRef rc As RECT) As Boolean
End Function
<DllImport("user32.dll")>
Friend 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
''' <summary>
''' <para>The DestroyWindow function destroys the specified window. The function sends WM_DESTROY and WM_NCDESTROY messages to the window to deactivate it and remove the keyboard focus from it. The function also destroys the window's menu, flushes the thread message queue, destroys timers, removes clipboard ownership, and breaks the clipboard viewer chain (if the window is at the top of the viewer chain).</para>
''' <para>If the specified window is a parent or owner window, DestroyWindow automatically destroys the associated child or owned windows when it destroys the parent or owner window. The function first destroys child or owned windows, and then it destroys the parent or owner window.</para>
''' <para>DestroyWindow also destroys modeless dialog boxes created by the CreateDialog function.</para>
''' </summary>
''' <param name="hwnd">Handle to the window to be destroyed.</param>
''' <returns>If the function succeeds, the return value is nonzero. If the function fails, the return value is zero. To get extended error information, call GetLastError.</returns>
<DllImport("user32.dll", CharSet:=CharSet.Unicode, SetLastError:=True)>
Friend Shared Function DestroyWindow(hwnd As IntPtr) As <MarshalAs(UnmanagedType.Bool)> Boolean
End Function
End Class
Structure RECT
Public Left As Integer
Public Top As Integer
Public Right As Integer
Public Bottom As Integer
End Structure
#End Region
#Region " Constructors "
''' <summary>
''' Initializes a new instance of the <see cref="CenteredMessageBox"/> class.
''' </summary>
''' <param name="Owner">Indicates the form that owns this messagebox.</param>
''' <param name="TextFont">Indicates the text-font used to display the text label.</param>
''' <param name="TimeOut">
''' Indicates the timeout, in ms, to auto-close this <see cref="CenteredMessageBox"/>
''' Default is '0' which means Infinite.
''' </param>
Public Sub New(ByVal Owner As Form,
Optional TextFont As Font = Nothing,
Optional TimeOut As Integer = 0I)
mOwner = Owner
mFont = TextFont
mTimeOut = TimeOut
Owner.BeginInvoke(New MethodInvoker(AddressOf findDialog))
End Sub
#End Region
#Region " Private MEthods "
Private Sub findDialog()
' Enumerate windows to find the message box
If mTries < 0 Then
Return
End If
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
If mTimeOut > 0 Then
TimeoutTimer = New Timer With {.Interval = mTimeOut, .Enabled = True}
TimeoutTimer.Start()
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
' Get the STATIC control that displays the text
Dim hText As IntPtr = NativeMethods.GetDlgItem(hWnd, &HFFFF)
Me._MessageBoxWindowHandle = hWnd
Dim frmRect As New Rectangle(mOwner.Location, mOwner.Size)
Dim dlgRect As RECT
NativeMethods.GetWindowRect(hWnd, dlgRect)
If hText <> IntPtr.Zero Then
If mFont Is Nothing Then
' Get the current font
mFont = Font.FromHfont(NativeMethods.SendMessage(hText, NativeMethods.WM_GETFONT, IntPtr.Zero, IntPtr.Zero))
ElseIf mFont IsNot Nothing Then
NativeMethods.SetWindowPos(hText, 0, 70, 35, frmRect.Width, mFont.Height, 0)
End If
NativeMethods.SendMessage(hText, NativeMethods.WM_SETFONT, mFont.ToHfont(), New IntPtr(1))
' Resize and positionate the messagebox window:
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)
End If
' Done
Return False
End Function
#End Region
#Region " Event Handlers "
Private Sub TimeoutTimer_Tick(ByVal sender As Object, ByVal e As EventArgs) Handles TimeoutTimer.Tick
NativeMethods.DestroyWindow(Me._MessageBoxWindowHandle)
Me.Dispose()
End Sub
#End Region
#Region " IDisposable "
Public Sub Dispose() Implements IDisposable.Dispose
mTries = -1
mOwner = Nothing
If mFont IsNot Nothing Then mFont.Dispose()
End Sub
#End Region
End Class
#End Region