`
uslt43uslt
  • 浏览: 11969 次
最近访客 更多访客>>
社区版块
存档分类
最新评论

可以设置显示位置和显示字体的消息框(MsgBox)

 
阅读更多

可以设置显示位置和显示字体的消息框(MsgBox)
2011年11月19日
  可以设置显示位置和显示字体的消息框(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
  '''
  ''' 可以设置为居中于某窗体,或任意位置的消息框
  '''
  '''
  Public Class MyMsgBox
  #Region "变量"
  '''
  ''' 消息框的位置类型
  '''
  '''
  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 "属性"
  '''
  ''' 消息框的字体
  '''
  '''
  '''
  '''
  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
  '''
  ''' 消息框的位置
  '''
  '''
  '''
  '''
  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
   Public Shared Function UnhookWindowsHookEx(ByVal hHook As Integer) As Integer
  End Function
   Public Shared Function GetWindowLong(ByVal hwnd As Integer, ByVal nIndex As Integer) As Integer
  End Function
   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
   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
   Public Shared Function GetWindowRect(ByVal hwnd As Integer, ByRef lpRect As RECT) As Integer
  End Function
   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
   Public Shared Function GetDesktopWindow() As Integer
  End Function
   Public Shared Function FindWindow(ByVal lpClassName As String, ByVal lpWindowName As String) As Integer
  End Function
   Public Shared Function FindWindowEx(ByVal hWndParent As Integer, ByVal hWndChildAfter As Integer, ByVal pClassName As String, ByVal lpWindowName As String) As Integer
  End Function
   Public Shared Function SendMessage(ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByRef lParam As Object) As Integer
  End Function
   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
   Public Shared Function ScreenToClientLong(ByVal hWnd As Integer, ByRef lpPoint As Integer) As Integer
  End Function
   Public Shared Function GetDC(ByVal hWnd As Integer) As Integer
  End Function
   Public Shared Function ReleaseDC(ByVal hWnd As Integer, ByVal hDC As Integer) As Integer
  End Function
   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
   Public Shared Function SetTimer(ByVal hWnd As Integer, ByVal nIDEvent As Integer, ByVal uElapse As Integer, ByVal lpTimerFunc As DelegateSettingFontProc) As Integer
  End Function
   Public Shared Function KillTimer(ByVal hWnd As Integer, ByVal nIDEvent As Integer) As Integer
  End Function
  #End Region
  #Region "显示消息框"
  '''
  ''' 显示消息框
  '''
  ''' 显示文字
  ''' 消息框标题
  ''' 按钮样式
  ''' 图标样式
  ''' 默认按钮
  ''' 消息框选项
  ''' 是否显示帮助按钮
  ''' 消息框的执行结果
  '''
  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 "设置消息框为居中或任意位置的委托"
  '''
  ''' 委托
  '''
  '''
  '''
  '''
  '''
  '''
  Delegate Function DelegateSettingPositionProc(ByVal lMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
  '''
  ''' 回调函数,根据不同的需求,进行不同设置
  '''
  '''
  '''
  '''
  '''
  '''
  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 "设置消息框为任意位置"
  '''
  ''' 消息框的位置设定
  '''
  '''
  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
  '''
  ''' 回调函数,设置窗体的位置
  '''
  '''
  '''
  '''
  '''
  '''
  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 "设置消息框居中"
  '''
  ''' 设置要显示的消息框居中于某窗体
  '''
  ''' 该窗体
  '''
  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
  '''
  ''' 回调函数,设置窗体居中
  '''
  '''
  '''
  '''
  '''
  '''
  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 "设置消息框的字体"
  '''
  ''' 设置字体的委托
  '''
  '''
  '''
  '''
  '''
  '''
  Delegate Sub DelegateSettingFontProc(ByVal hWnd As Integer, ByVal uMsg As Integer, ByVal idEvent As Integer, ByVal dwTime As Integer)
  '''
  ''' 设置字体
  '''
  '''
  '''
  '''
  '''
  '''
  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
分享到:
评论

相关推荐

Global site tag (gtag.js) - Google Analytics