vb.net 带有自定义字体的 MessageBox？

Question

提问by ElektroStudios

Is there an easy way to display a custom font for a MessageBox?

有没有一种简单的方法来显示 MessageBox 的自定义字体？

For "easy way" I mean using WinAPI or other techniques but not coding a entire messagebox from scratch.

对于“简单方法”，我的意思是使用 WinAPI 或其他技术，但不是从头开始编写整个消息框。

I've seen lots of custom messagebox but most are just forms which don't preserve default messagebox additional parametters, other custom messagebox just has their size/bounds wrong so the "ok" button is cutted or not right alligned, and other custom messagebox has their own problems/bugs.

我见过很多自定义消息框，但大多数只是不保留默认消息框附加参数的表单，其他自定义消息框的大小/边界错误，因此“确定”按钮被剪切或未正确对齐，以及其他自定义消息框有他们自己的问题/错误。

I hope if is possibly to add a generic parametter to instance this great custom messagebox setting the desired font:

我希望是否可以添加一个通用参数来实例这个伟大的自定义消息框设置所需的字体：

The original code is a C# custom messagebox class of @Hans Passantwhich I've taken a lot time ago from here Winforms-How can I make MessageBox appear centered on MainForm?and translated it using an online translator:

原始代码是@Hans Passant的 C# 自定义消息框类，我很久以前从这里拿走了Winforms-如何使 MessageBox 以 MainForm 为中心显示？并使用在线翻译器进行翻译：

' [ Centered Messagebox ]
'
' Examples :
'
' Using New MessageBox_Centered(Me)
'     MessageBox.Show("Test Text", "Test Title", MessageBoxButtons.OK)
' End Using

#Region " Centered MessageBox Class"

Imports System.Runtime.InteropServices
Imports System.Text

Class MessageBox_Centered
Implements IDisposable

' P/Invoke
Public Class NativeMethods

    Delegate Function EnumThreadWndProc(hWnd As IntPtr, lp As IntPtr) As Boolean

    <DllImport("user32.dll")> _
    Shared Function EnumThreadWindows(tid As Integer, callback As EnumThreadWndProc, lp As IntPtr) As Boolean
    End Function

    <DllImport("kernel32.dll")> _
    Shared Function GetCurrentThreadId() As Integer
    End Function

    <DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Unicode)> _
    Shared Function GetClassName(hWnd As IntPtr, buffer As StringBuilder, buflen As Integer) As Integer
    End Function

    <DllImport("user32.dll")> _
    Shared Function GetWindowRect(hWnd As IntPtr, ByRef rc As RECT) As Boolean
    End Function

    <DllImport("user32.dll")> _
    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

    Structure RECT
        Public Left As Integer
        Public Top As Integer
        Public Right As Integer
        Public Bottom As Integer
    End Structure

End Class

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

    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

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

    ' Got it
    Dim frmRect As New Rectangle(mOwner.Location, mOwner.Size)
    Dim dlgRect As NativeMethods.RECT
    NativeMethods.GetWindowRect(hWnd, dlgRect)
    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)
    Return False

End Function

Public Sub Dispose() Implements IDisposable.Dispose
    mTries = -1
End Sub

End Class

#End Region

UPDATE:

更新：

Trying to adapt @Pete supposed solution just I can't do it.

试图适应@Pete 假设的解决方案只是我做不到。

Class MessageBox_Centered : Implements IDisposable

Public Class NativeMethods

    Delegate Function EnumThreadWndProc(hWnd As IntPtr, lp As IntPtr) As Boolean
    Delegate Function EnumWindowsProc(hWnd As IntPtr, lp As IntPtr) As Boolean

    <DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)> _
    Shared Function EnumThreadWindows(tid As Integer, callback As EnumThreadWndProc, lp As IntPtr) As Boolean
    End Function

    <DllImport("kernel32.dll", SetLastError:=True, CharSet:=CharSet.Auto)> _
    Shared Function GetCurrentThreadId() As Integer
    End Function

    <DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)> _
    Shared Function GetClassName(hWnd As IntPtr, buffer As StringBuilder, buflen As Integer) As Integer
    End Function

    <DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)> _
    Shared Function GetWindowRect(hWnd As IntPtr, ByRef rc As RECT) As Boolean
    End Function

    <DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)> _
    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


    <DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)> _
    Shared Function GetWindowText(ByVal hwnd As IntPtr, ByVal lpString As StringBuilder, ByVal cch As Integer) As Integer
    End Function

    <DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)> _
    Shared Function EnumChildWindows(hwndParent As IntPtr, lpEnumFunc As EnumWindowsProc, lParam As IntPtr) As <MarshalAs(UnmanagedType.Bool)> Boolean
    End Function

    <DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)> _
    Shared Function SendMessage(hWnd As IntPtr, Msg As UInt32, wParam As IntPtr, lParam As IntPtr) As IntPtr
    End Function

    Structure RECT
        Public Left As Integer
        Public Top As Integer
        Public Right As Integer
        Public Bottom As Integer
    End Structure

End Class

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

    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

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
    End If


    ' Got it
    Dim frmRect As New Rectangle(mOwner.Location, mOwner.Size)
    Dim dlgRect As NativeMethods.RECT
    NativeMethods.GetWindowRect(hWnd, dlgRect)
    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)

    ' Dim wndText As New StringBuilder()
    ' NativeMethods.GetWindowText(hWnd2, wndText, 1000)
    ' SendMessage(hWnd2, WM_SETFONT, f.ToHfont(), new IntPtr(1))

    Return False

End Function

Public Sub Dispose() Implements IDisposable.Dispose
    mTries = -1
End Sub

End Class

UPDATE 2:

更新 2：

This is an explanation of what I need to do.

这是对我需要做的事情的解释。

Taking the code snippet of @Hans Passant, the centered messagebox, I need to launch it (instance it) but with a custom font.

取@Hans Passant 的代码片段，居中的消息框，我需要使用自定义字体启动它（例如它）。

An example could be creating a generic function into the Centered Messageboxmaybe using the "new" block of the Class to pass the desired font as an argument then do the necessary things with that font to show the messagebox centered + with a custom font.

一个例子可能是在居中的消息框中创建一个通用函数，可能使用类的“新”块将所需的字体作为参数传递，然后使用该字体执行必要的操作以显示消息框居中 + 使用自定义字体。

So what I need is to extend the class by adding the possibility of using custom fonts.

所以我需要的是通过添加使用自定义字体的可能性来扩展类。

Answer 1

回答by Hans Passant

I already answered this question, the answer is here. You just need to tweak is slightly since you are not interested in changing the existing font:

这个问题我已经回答过了，答案就在这里。您只需要稍微调整一下，因为您对更改现有字体不感兴趣：

if (hText != IntPtr.Zero) {
  // Get the current font
  IntPtr hFont = SendMessage(hText, WM_GETFONT, IntPtr.Zero, IntPtr.Zero);
  Font font = Font.FromHfont(hFont);
  mFont = new Font(new FontFamily("Arial"), font.SizeInPoints, FontStyle.Normal);
  SendMessage(hText, WM_SETFONT, mFont.ToHfont(), (IntPtr)1);
}

Only the 5th line is different. Change the font family you want. The same basic problem with this code, although not nearly as severe, the new font you pick mustfit the calculated size of the static control. A calculation that was made for the original font. If your new font is "wide" then it won't fit, reducing the SizeInPoints is the only workaround.

只有第 5 行不同。更改您想要的字体系列。与此代码相同的基本问题，虽然没有那么严重，但您选择的新字体必须适合静态控件的计算大小。对原始字体进行的计算。如果您的新字体是“宽”字体，那么它将不适合，减少 SizeInPoints 是唯一的解决方法。

Answer 2

回答by Pete

First of all, I apologize for my answer not being in VB (Update- Ran the code through a C# to VB converter). Surely you can read C# well enough to make sense of this and I will happily answer any questions you have about it.

首先，我为我的答案不在 VB 中道歉（更新- 通过 C# 到 VB 转换器运行代码）。当然，您可以很好地阅读 C# 以理解这一点，我将很乐意回答您对此的任何问题。

This solution is not generic, in terms of how you go about finding the window and the static control. You'll need to adapt it to your own situation, but the important piece about how to set the font is reusable.

就您如何查找窗口和静态控件而言，此解决方案并不通用。您需要根据自己的情况调整它，但关于如何设置字体的重要部分是可重用的。

The Thread.Sleep()at the beginning of the thread is a little arbitrary. You'll probably want to wait a bit (a half second is surely too long), but it will take time for the message box to be displayed and the message box will block execution. So, I fire off the thread, have it wait until the message box is definitely open, and then I start looking for it.

将Thread.Sleep()在螺纹的开始是有点武断。您可能需要稍等一下（半秒肯定太长了），但是显示消息框需要时间，并且消息框将阻止执行。所以，我关闭线程，让它等到消息框绝对打开，然后我开始寻找它。

Also, be sure to call DeleteObject()on the HFont eventually.

此外，请务必DeleteObject()最终调用HFont。

Public Partial Class Form1
    Inherits Form
    Private Const WM_SETFONT As UInt32 = &H30

    Private Delegate Function EnumThreadDelegate(hwnd As IntPtr, lParam As IntPtr) As Boolean
    Private Delegate Function EnumWindowsProc(hWnd As IntPtr, lParam As IntPtr) As Boolean

    <DllImport("user32.dll")> _
    Private Shared Function EnumThreadWindows(dwThreadId As UInteger, lpfn As EnumThreadDelegate, lParam As IntPtr) As <MarshalAs(UnmanagedType.Bool)> Boolean
    End Function

    <DllImport("kernel32.dll")> _
    Private Shared Function GetCurrentThreadId() As UInteger
    End Function

    <DllImport("user32.dll", SetLastError := True, CharSet := CharSet.Auto)> _
    Private Shared Function GetClassName(hWnd As IntPtr, lpClassName As StringBuilder, nMaxCount As Integer) As Integer
    End Function

    <DllImport("user32.dll")> _
    Private Shared Function EnumChildWindows(hwndParent As IntPtr, lpEnumFunc As EnumWindowsProc, lParam As IntPtr) As <MarshalAs(UnmanagedType.Bool)> Boolean
    End Function

    <DllImport("user32.dll", CharSet := CharSet.Auto, SetLastError := True)> _
    Private Shared Function GetWindowText(hWnd As IntPtr, lpString As StringBuilder, nMaxCount As Integer) As Integer
    End Function

    <DllImport("user32.dll", CharSet := CharSet.Auto)> _
    Private Shared Function SendMessage(hWnd As IntPtr, Msg As UInt32, wParam As IntPtr, lParam As IntPtr) As IntPtr
    End Function

    Shared threadId As UInteger = GetCurrentThreadId()

    Public Sub New()
        InitializeComponent()
    End Sub

    Private Sub button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        Dim t As New Thread(New ThreadStart(AddressOf FixMsgBoxFont))
        t.Start()
        MessageBox.Show(Me, "MyMsg", "Test")
    End Sub

    Private Sub FixMsgBoxFont()
        Thread.Sleep(500)
        EnumThreadWindows(threadId, New EnumThreadDelegate(Function(hWnd, lParam) 
        Dim className As New StringBuilder()
        GetClassName(hWnd, className, 1000)

        ' Look for the message box window
        If className.ToString() <> "#32770" Then
            Return True
        End If

        EnumChildWindows(hWnd, New EnumWindowsProc(Function(hWnd2, lParam2) 
        Dim wndText As New StringBuilder()
        GetWindowText(hWnd2, wndText, 1000)

        ' Look for the static control with our text
        If wndText.ToString() = "MyMsg" Then
            ' Replace the font being used with 8pt Comix Sans MS
            Dim f As New Font(New FontFamily("Comic Sans MS"), 8, FontStyle.Bold, GraphicsUnit.Pixel)

            ' In real life, you'll eventually want to eventually call 
            ' the Windows API DeleteObject() on the font handle
            ' below or it will leak.
            Dim fontHandle As IntPtr = f.ToHfont()
            SendMessage(hWnd2, WM_SETFONT, f.ToHfont(), New IntPtr(1))
            Return False
        End If
        Return True

End Function), IntPtr.Zero)

        Return False

End Function), IntPtr.Zero)
    End Sub
End Class

Answer 3

回答by ElektroStudios

Here is the code!

这是代码！

It has the font-size problem which I need to resolve but by now this is solved!

它有我需要解决的字体大小问题，但现在已经解决了！

' The author of this code is Hand Passant: 
' http://stackoverflow.com/questions/2259027/bold-text-in-messagebox/2259213#2259213
'
' I've just translated it to VB.NET and made very little modifications.

Imports System.Drawing
Imports System.Runtime.InteropServices
Imports System.Text
Imports System.Windows.Forms

Class CustomMessageBox : Implements IDisposable

Private mTries As Integer = 0
Private mOwner As Form
Private mFont As Font

' P/Invoke declarations
Private Const WM_SETFONT As Integer = &H30
Private Const WM_GETFONT As Integer = &H31

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 GetDlgItem(hWnd As IntPtr, item As Integer) As IntPtr
End Function

<DllImport("user32.dll")> _
Private Shared Function SendMessage(hWnd As IntPtr, msg As Integer, wp As IntPtr, lp As IntPtr) As IntPtr
End Function

<DllImport("user32.dll")> _
Shared Function GetWindowRect(hWnd As IntPtr, ByRef rc As RECT) As Boolean
End Function

<DllImport("user32.dll")> _
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

Structure RECT
    Public Left As Integer
    Public Top As Integer
    Public Right As Integer
    Public Bottom As Integer
End Structure

Public Sub New(owner As Form, Optional Custom_Font As Font = Nothing)
    mOwner = owner
    mFont = Custom_Font
    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

    ' Got it, get the STATIC control that displays the text
    Dim hText As IntPtr = GetDlgItem(hWnd, &HFFFF)

    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)
    If hText <> IntPtr.Zero Then

        If mFont Is Nothing Then
            ' Get the current font
            mFont = Font.FromHfont(SendMessage(hText, WM_GETFONT, IntPtr.Zero, IntPtr.Zero))
        End If

        SendMessage(hText, WM_SETFONT, mFont.ToHfont(), New IntPtr(1))

    End If

    ' Done
    Return False

End Function

Public Sub Dispose() Implements IDisposable.Dispose
    mTries = -1
    mOwner = Nothing
    If mFont IsNot Nothing Then mFont.Dispose()
End Sub

End Class

Usage:

用法：

Using New CustomMessageBox(Me, New Font(New FontFamily("Lucida Console"), Font.SizeInPoints, FontStyle.Bold))
    MessageBox.Show("Test Text", "Test Title", MessageBoxButtons.OK)
End Using

vb.net 带有自定义字体的 MessageBox？

提问by ElektroStudios

回答by Hans Passant

回答by Pete

回答by ElektroStudios

相关推荐

最近更新

标签

vb.net 带有自定义字体的 MessageBox？

提问by ElektroStudios

回答by Hans Passant

回答by Pete

回答by ElektroStudios

相关推荐

VB.NET 数组包含方法不起作用

在 VB.NET 中将 Byte 转换为 Char 时出现语法错误

vb.net 检查列表框是否包含文本框

vb.net 如何使用按键VB更改文本框的背景色

相关推荐

最近更新

标签