可以設定顯示位置和顯示字型的訊息框(MsgBox)

.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