.Net默认的msgbox显示位置只能是屏幕中间，字体为宋体，
许多情况下我们需要msgbox显示在指定的位置，而且能够控制msgbox的字体等
我封装了一个可以设置显示位置和字体的消息框，用APi来实现的，其参数和msgbox一样
用法是：
Dim pm As New MyMsgBox
pm.Location = 你的位置 ''设置位置
pm.MsgFont = 你的字体 ''设置字体
pm.Show("文本", "标题")
还可以使之居于某个窗体中间：pm.CenterToForm(你的form)
下面是源码(VB.Net)，
其中源码中还涉及到API函数在VB.Net中的调用技巧，
API函数在VB中应用起来很方便，但是在VB.Net中应用并不和VB中一样，
需要进行参数类型的修改，否则就会出现堆栈不对称的错误，
往往就是因为这类错误，导致在VB中用API方便实现的大量功能都无法顺畅的转换到VB.Net中
（其中参数类型的修改可以参见MSDN中非托管DLL的调用相关知识）
Imports System.Windows.Forms
Imports System.Drawing
Imports System.Runtime.InteropServices
''' <summary>
''' 可以设置为居中于某窗体，或任意位置的消息框
''' </summary>
''' <remarks></remarks>
Public Class MyMsgBox
#Region "变量"
''' <summary>
''' 消息框的位置类型
''' </summary>
''' <remarks></remarks>
Private Enum MyMessageBoxPosType
msgCenterForm = 0
msgLocation = 1
End Enum
Private m_CenterForm As Form
Private m_Location As Point
Private m_Font As Font
Private m_MessageBoxType As MyMessageBoxPosType
Private m_Title As String
Private m_Text As String
#End Region
#Region "属性"
''' <summary>
''' 消息框的字体
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
Property MsgFont() As Font
Get
Return m_Font
End Get
Set(ByVal value As Font)
m_Font = value
SetTimer(0, 0, 10&, AddressOf SettingFontProc)
End Set
End Property
''' <summary>
''' 消息框的位置
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
Property Location() As Point
Get
Return m_Location
End Get
Set(ByVal value As Point)
m_Location = value
LocationMsgBox()
End Set
End Property
#End Region
#Region "窗体位置设置API声明相关"
Structure RECT
Public Left As Integer
Public Top As Integer
Public Right As Integer
Public Bottom As Integer
End Structure
Public Const GWL_HINSTANCE = (-6)
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOZORDER = &H4
Public Const SWP_NOACTIVATE = &H10
Public Const HCBT_ACTIVATE = 5
Public Const WH_CBT = 5
Public hHook As Integer
<DllImport("user32.dll")> Public Shared Function UnhookWindowsHookEx(ByVal hHook As Integer) As Integer
End Function
<DllImport("user32.dll", EntryPoint:="GetWindowLongA")> Public Shared Function GetWindowLong(ByVal hwnd As Integer, ByVal nIndex As Integer) As Integer
End Function
<DllImport("user32.dll", EntryPoint:="SetWindowsHookExA")> Public Overloads Shared Function SetWindowsHookEx(ByVal idHook As Integer, ByVal lpfn As DelegateSettingPositionProc, ByVal hmod As Integer, ByVal dwThreadId As Integer) As Integer
End Function
<DllImport("user32.dll")> Public Shared Function SetWindowPos(ByVal hwnd As Integer, ByVal hWndInsertAfter As Integer, ByVal x As Integer, ByVal y As Integer, ByVal cx As Integer, ByVal cy As Integer, ByVal wFlags As Integer) As Integer
End Function
<DllImport("user32.dll")> Public Shared Function GetWindowRect(ByVal hwnd As Integer, ByRef lpRect As RECT) As Integer
End Function
<DllImport("kernel32.dll")> Public Shared Function GetCurrentThreadId() As Integer
End Function
#End Region
#Region "消息框字体设置API声明相关"
Public Const TURN_ON_UPDATES As Long = 0
Public Const API_TRUE As Long = 1&
Public Const API_FALSE As Long = 0&
Public Const WM_SETFONT As Long = &H30&
Public Const WM_SETTEXT As Long = &HC&
Public Const WM_SETREDRAW As Long = &HB&
'绘制文本的flags
Public Const DT_WORDBREAK As Long = &H10&
Public Const DT_CALCRECT As Long = &H400&
Public Const DT_EDITCONTROL As Long = &H2000&
Public Const DT_END_ELLIPSIS As Long = &H8000&
Public Const DT_MODIFYSTRING As Long = &H10000
Public Const DT_PATH_ELLIPSIS As Long = &H4000&
Public Const DT_RTLREADING As Long = &H20000
Public Const DT_WORD_ELLIPSIS As Long = &H40000
<DllImport("user32.dll")> Public Shared Function GetDesktopWindow() As Integer
End Function
<DllImport("user32.dll", EntryPoint:="FindWindowA")> Public Shared Function FindWindow(ByVal lpClassName As String, ByVal lpWindowName As String) As Integer
End Function
<DllImport("user32.dll", EntryPoint:="FindWindowExA")> Public Shared Function FindWindowEx(ByVal hWndParent As Integer, ByVal hWndChildAfter As Integer, ByVal pClassName As String, ByVal lpWindowName As String) As Integer
End Function
<DllImport("user32.dll", EntryPoint:="SendMessageA")> Public Shared Function SendMessage(ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByRef lParam As Object) As Integer
End Function
<DllImport("user32.dll")> Public Shared Function MoveWindow(ByVal hWnd As Integer, ByVal x As Integer, ByVal y As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal bRepaint As Integer) As Integer
End Function
<DllImport("user32.dll", EntryPoint:="ScreenToClient")> Public Shared Function ScreenToClientLong(ByVal hWnd As Integer, ByRef lpPoint As Integer) As Integer
End Function
<DllImport("user32.dll")> Public Shared Function GetDC(ByVal hWnd As Integer) As Integer
End Function
<DllImport("user32.dll")> Public Shared Function ReleaseDC(ByVal hWnd As Integer, ByVal hDC As Integer) As Integer
End Function
<DllImport("user32.dll", EntryPoint:="DrawTextA")> Public Shared Function DrawText(ByVal hDC As Integer, ByVal lpsz As String, ByVal cchText As Integer, ByRef lpRect As RECT, ByVal dwDTFormat As Integer) As Integer
End Function
<DllImport("user32.dll")> Public Shared Function SetTimer(ByVal hWnd As Integer, ByVal nIDEvent As Integer, ByVal uElapse As Integer, ByVal lpTimerFunc As DelegateSettingFontProc) As Integer
End Function
<DllImport("user32.dll")> Public Shared Function KillTimer(ByVal hWnd As Integer, ByVal nIDEvent As Integer) As Integer
End Function
#End Region
#Region "显示消息框"
''' <summary>
''' 显示消息框
''' </summary>
''' <param name="text">显示文字</param>
''' <param name="title">消息框标题</param>
''' <param name="buttons">按钮样式</param>
''' <param name="icon">图标样式</param>
''' <param name="defaultButton">默认按钮</param>
''' <param name="options">消息框选项</param>
''' <param name="displayHelpButton">是否显示帮助按钮</param>
''' <returns>消息框的执行结果</returns>
''' <remarks></remarks>
Public Function Show(ByVal text As String, Optional ByVal title As String = "", Optional ByVal buttons As MessageBoxButtons = 0, Optional ByVal icon As MessageBoxIcon = 0, Optional ByVal defaultButton As MessageBoxDefaultButton = 0, Optional ByVal options As MessageBoxOptions = 0, Optional ByVal displayHelpButton As Boolean = False) As DialogResult
m_Text = text
m_Title = title
Return MessageBox.Show(text, title, buttons, icon, defaultButton, options, displayHelpButton)
End Function
#End Region
#Region "设置消息框为居中或任意位置的委托"
''' <summary>
''' 委托
''' </summary>
''' <param name="lMsg"></param>
''' <param name="wParam"></param>
''' <param name="lParam"></param>
''' <returns></returns>
''' <remarks></remarks>
Delegate Function DelegateSettingPositionProc(ByVal lMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
''' <summary>
''' 回调函数，根据不同的需求，进行不同设置
''' </summary>
''' <param name="lMsg"></param>
''' <param name="wParam"></param>
''' <param name="lParam"></param>
''' <returns></returns>
''' <remarks></remarks>
Private Function SettingPositionProc(ByVal lMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
Select Case m_MessageBoxType
Case MyMessageBoxPosType.msgCenterForm
CenterMsgBoxProc(lMsg, wParam, lParam)
Case MyMessageBoxPosType.msgLocation
LocationMsgBoxProc(lMsg, wParam, lParam)
End Select
End Function
#End Region
#Region "设置消息框为任意位置"
''' <summary>
''' 消息框的位置设定
''' </summary>
''' <remarks></remarks>
Private Sub LocationMsgBox()
m_MessageBoxType = MyMessageBoxPosType.msgLocation
Dim hInst As Integer
Dim Thread As Integer
'设置CBT hook
hInst = GetWindowLong(0, GWL_HINSTANCE)
Thread = GetCurrentThreadId()
hHook = SetWindowsHookEx(WH_CBT, AddressOf SettingPositionProc, hInst, Thread)
End Sub
''' <summary>
''' 回调函数，设置窗体的位置
''' </summary>
''' <param name="lMsg"></param>
''' <param name="wParam"></param>
''' <param name="lParam"></param>
''' <returns></returns>
''' <remarks></remarks>
Function LocationMsgBoxProc(ByVal lMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
If lMsg = HCBT_ACTIVATE Then
'设置msgbox的位置
SetWindowPos(wParam, 0, m_Location.X, m_Location.Y, 0, 0, SWP_NOSIZE Or SWP_NOZORDER Or SWP_NOACTIVATE)
'释放CBT hook
UnhookWindowsHookEx(hHook)
End If
End Function
#End Region
#Region "设置消息框居中"
''' <summary>
''' 设置要显示的消息框居中于某窗体
''' </summary>
''' <param name="centerForm">该窗体</param>
''' <remarks></remarks>
Public Sub CenterToForm(ByVal centerForm As Form)
m_MessageBoxType = MyMessageBoxPosType.msgCenterForm
m_CenterForm = centerForm
Dim hInst As Integer
Dim Thread As Integer
'设置CBT hook
hInst = GetWindowLong(m_CenterForm.Handle, GWL_HINSTANCE)
Thread = GetCurrentThreadId()
hHook = SetWindowsHookEx(WH_CBT, AddressOf SettingPositionProc, hInst, Thread)
End Sub
''' <summary>
''' 回调函数，设置窗体居中
''' </summary>
''' <param name="lMsg"></param>
''' <param name="wParam"></param>
''' <param name="lParam"></param>
''' <returns></returns>
''' <remarks></remarks>
Function CenterMsgBoxProc(ByVal lMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
Dim rectForm As RECT, rectMsg As RECT
Dim x As Integer, y As Integer
'当lmsg为HCBT_ACTIVATE, 设置msgbox居中于窗体
If lMsg = HCBT_ACTIVATE Then
''得到form和msgbox的位置，以便可以进行msgbox的位置设定
GetWindowRect(m_CenterForm.Handle, rectForm)
GetWindowRect(wParam, rectMsg)
x = (rectForm.Left + (rectForm.Right - rectForm.Left) / 2) - ((rectMsg.Right - rectMsg.Left) / 2)
y = (rectForm.Top + (rectForm.Bottom - rectForm.Top) / 2) - ((rectMsg.Bottom - rectMsg.Top) / 2)
'设置msgbox的位置
SetWindowPos(wParam, 0, x, y, 0, 0, SWP_NOSIZE Or SWP_NOZORDER Or SWP_NOACTIVATE)
'释放CBT Hook
UnhookWindowsHookEx(hHook)
End If
End Function
#End Region
#Region "设置消息框的字体"
''' <summary>
''' 设置字体的委托
''' </summary>
''' <param name="hWnd"></param>
''' <param name="uMsg"></param>
''' <param name="idEvent"></param>
''' <param name="dwTime"></param>
''' <remarks></remarks>
Delegate Sub DelegateSettingFontProc(ByVal hWnd As Integer, ByVal uMsg As Integer, ByVal idEvent As Integer, ByVal dwTime As Integer)
''' <summary>
''' 设置字体
''' </summary>
''' <param name="hWnd"></param>
''' <param name="uMsg"></param>
''' <param name="idEvent"></param>
''' <param name="dwTime"></param>
''' <remarks></remarks>
Public Sub SettingFontProc(ByVal hWnd As Integer, ByVal uMsg As Integer, ByVal idEvent As Integer, ByVal dwTime As Integer)
KillTimer(hWnd, idEvent)
Dim hMsgBox As Integer
''得到消息框句柄
hMsgBox = FindWindow("#32770", m_Title)
If hMsgBox Then
Dim hStatic As Integer, hButton As Integer
Dim stStaticRect, stButtonRect, stMsgBoxRect2 As RECT
''得到static control和button的句柄
hStatic = FindWindowEx(hMsgBox, API_FALSE, "Static", m_Text)
hButton = FindWindowEx(hMsgBox, API_FALSE, "Button", "OK")
''改变字体，并重新定义显示大小
If hStatic Then
''得到消息框、文本、按钮的范围
GetWindowRect(hMsgBox, stMsgBoxRect2)
GetWindowRect(hStatic, stStaticRect)
GetWindowRect(hButton, stButtonRect)
''设置消息框的字体
SendMessage(hStatic, WM_SETFONT, m_Font.ToHfont, API_TRUE)
SendMessage(hButton, WM_SETTEXT, 0&, "Close")
Dim nRectHeight&, nHeightDifference&, hStaticDC&
With stStaticRect
'将坐标从屏幕转换到当前窗体
ScreenToClientLong(hMsgBox, .Left)
ScreenToClientLong(hMsgBox, .Right)
'得到当前文字的高度
nHeightDifference = .Bottom - .Top
'得到static control的dc
hStaticDC = GetDC(hStatic)
nRectHeight = DrawText(hStaticDC, m_Text, (-1&), stStaticRect, DT_CALCRECT Or DT_EDITCONTROL Or DT_WORDBREAK)
''释放DC
ReleaseDC(hStatic, hStaticDC)
nHeightDifference = nRectHeight - nHeightDifference
'调整msgbox的大小
MoveWindow(hStatic, .Left, .Top, .Right - .Left, nRectHeight, API_TRUE)
End With
''将按钮移动相应的位置
With stButtonRect
ScreenToClientLong(hMsgBox, .Left)
ScreenToClientLong(hMsgBox, .Right)
MoveWindow(hButton, .Left, .Top + nHeightDifference, .Right - .Left, .Bottom - .Top, API_TRUE)
End With
With stMsgBoxRect2
MoveWindow(hMsgBox, .Left, .Top - (nHeightDifference \ 2), .Right - .Left, (.Bottom - .Top) + nHeightDifference, API_TRUE)
End With
End If
End If
'解除对其的锁定
If TURN_ON_UPDATES Then SendMessage(GetDesktopWindow(), WM_SETREDRAW, API_TRUE, 0&)
End Sub
#End Region
End Class