有没有一种方法可以在不子类化或挂钩的情况下居中一个MessageBox?
我正在寻找VB.NET代码。
我正在寻找VB.NET代码。
VB.NET的解决方案:
这段代码是从@Hans Passant的答案中提取和翻译的:Winforms-How can I make MessageBox appear centered on MainForm?
Centered_MessageBox.vb
Imports System.Text
Imports System.Drawing
Imports System.Windows.Forms
Imports System.Runtime.InteropServices
Class Centered_MessageBox
Implements IDisposable
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
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
End If
' Got it
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)
Return False
End Function
Public Sub Dispose() Implements IDisposable.Dispose
mTries = -1
End Sub
' P/Invoke declarations
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 GetWindowRect(hWnd As IntPtr, ByRef rc As RECT) As Boolean
End Function
<DllImport("user32.dll")> _
Private 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
Private Structure RECT
Public Left As Integer
Public Top As Integer
Public Right As Integer
Public Bottom As Integer
End Structure
End Class
用法:
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Using New Centered_MessageBox(Me)
MessageBox.Show("Test Text", "Test Title", MessageBoxButtons.OK)
End Using
End Sub
遗憾的是,没有办法将 MessageBox
居中于父级。它默认居中于屏幕,无法更改。
创建自己的表单 - 简单创建一个表单(在属性中设置controlbox为false) 放置文本框(称为TextBox_Prompt)并在属性中将其设置为多行 在文本框下方添加3个按钮(宽度/高度足够舒适地容纳“取消”) 将以下代码添加到您的表单中(我使用 | 字符表示换行):
Public Class frmMsgBox
Private mName As String = "Message Box" ' default name for form
Private mLocation As Point = New Point(400, 400) ' default location in case user does set
Private mStyle As MsgBoxStyle
Private mPrompt As String
Private mResult As MsgBoxResult
Private b1Result As MsgBoxResult
Private b2Result As MsgBoxResult
Private b3Result As MsgBoxResult
Public WriteOnly Property Style As MsgBoxStyle
Set(value As MsgBoxStyle)
mStyle = value
End Set
End Property
Public WriteOnly Property Prompt As String
Set(value As String)
mPrompt = value
End Set
End Property
Public ReadOnly Property Result As MsgBoxResult
Get
Return mResult
End Get
End Property
Public WriteOnly Property pLocation As Point
Set(value As Point)
mLocation = value
End Set
End Property
Public WriteOnly Property sName As String
Set(value As String)
mName = value
End Set
End Property
Private Sub frmMsgBox_Load(sender As Object, e As EventArgs) Handles Me.Load
Dim strPrompt() As String = mPrompt.Split("|") ' use | for splitting lines
Dim sWidth As Integer = 0
Dim sHeight As String = ""
Me.Text = mName
For Each sLine As String In strPrompt ' get maximum width and height necessary for Prompt TextBox
sWidth = Math.Max(sWidth, TextRenderer.MeasureText(sLine, TextBox_Prompt.Font).Width)
sHeight += "@" + vbCrLf ' TextRenderer.MeasureText("@", TextBox_Prompt.Font).Height
TextBox_Prompt.Text += sLine + vbCrLf
Next
TextBox_Prompt.Width = Math.Min(800, sWidth + 5) ' set max width arbitrarily at 800
TextBox_Prompt.Height = Math.Min(600, TextRenderer.MeasureText(sHeight, TextBox_Prompt.Font).Height) ' set max height to 600 pixels
Me.Width = Math.Max(Me.Width, TextBox_Prompt.Width + Me.Width - Me.ClientRectangle.Width + 20)
TextBox_Prompt.Left = Math.Max(10, (Me.ClientRectangle.Width - TextBox_Prompt.Width) \ 2)
Button1.Top = TextBox_Prompt.Top + TextBox_Prompt.Height + 20
Button2.Top = Button1.Top : Button3.Top = Button1.Top
Me.Height = Me.Height - Me.ClientRectangle.Height + 2 * TextBox_Prompt.Top + TextBox_Prompt.Height + Button1.Height + 20
Dim Space2 As Integer = (Me.ClientRectangle.Width - 2 * Button1.Width) / 3
Dim Space3 As Integer = (Me.ClientRectangle.Width - 3 * Button1.Width) / 4
Select Case mStyle
Case MsgBoxStyle.AbortRetryIgnore
Button1.Text = "Abort" : Button2.Text = "Retry" : Button3.Text = "Ignore"
Button1.Left = Space3
Button2.Left = 2 * Space3 + Button1.Width
Button3.Left = 3 * Space3 + 2 * Button1.Width
b1Result = MsgBoxResult.Abort : b2Result = MsgBoxResult.Retry : b3Result = MsgBoxResult.Ignore
Case MsgBoxStyle.YesNoCancel
Button1.Text = "Yes" : Button2.Text = "No" : Button3.Text = "Cancel"
Button1.Left = Space3
Button2.Left = 2 * Space3 + Button1.Width
Button3.Left = 3 * Space3 + 2 * Button1.Width
b1Result = MsgBoxResult.Yes : b2Result = MsgBoxResult.No : b3Result = MsgBoxResult.Cancel
Case MsgBoxStyle.YesNo
Button1.Text = "Yes" : Button2.Text = "No" : Button3.Visible = False
Button1.Left = Space2
Button2.Left = 2 * Space2 + Button1.Width
b1Result = MsgBoxResult.Yes : b2Result = MsgBoxResult.No
Case MsgBoxStyle.OkCancel
Button1.Text = "Ok" : Button2.Text = "Cancel" : Button3.Visible = False
Button1.Left = Space2
Button2.Left = 2 * Space2 + Button1.Width
b1Result = MsgBoxResult.Ok : b2Result = MsgBoxResult.Cancel
Case MsgBoxStyle.RetryCancel
Button1.Text = "Retry" : Button2.Text = "Cancel" : Button3.Visible = False
Button1.Left = Space2
Button2.Left = 2 * Space2 + Button1.Width
b1Result = MsgBoxResult.Retry : b2Result = MsgBoxResult.Cancel
Case MsgBoxStyle.OkOnly
Button1.Visible = False : Button2.Text = "Ok" : Button3.Visible = False
Button1.Left -= Space2 : Button2.Width += 2 * Space2
b2Result = MsgBoxResult.Ok
End Select
Me.Location = New Point(mLocation.X - Me.Width \ 2, mLocation.Y - Me.Height \ 2)
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
mResult = b1Result
Me.Close()
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
mResult = b2Result
Me.Close()
End Sub
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
mResult = b3Result
Me.Close()
End Sub
End Class
Dim ans as MsgBoxResult
Using f As New frmMsgBox With {
.sName = "form tile goes here ",
.Style = MsgBoxStyle.YesNoCancel, ' or whatever style
.Prompt = "Your prompt|2nd line||4th line",
.pLocation = New Point(Me.Left + Me.Width \ 2, Me.Top + Me.Height \ 2)
} ' this location will center MsgBox on form
f.ShowDialog()
ans = f.Result
End Using
If ans = MsgBoxResult.Yes Then
'do whatever
ElseIf ans = MsgBoxResult.No then
'do not whatever
Else ' was cancel
' do cancel
End If
我经常使用这个表格。你还可以在表格中添加图片属性/框以及其他内容。 Georg