前書き：
ここで@Hans Passantによって最初に書かれたカスタムメッセージボックスクラスを使用しています:Winforms -MainFormの中心にMessageBoxを表示するにはどうすればよいですか?
（私が使用している修正版はこの質問の一番下にあります）
カスタム メッセージ ボックスは、カスタム テキスト フォントを受け取って表示できます。
これは使用例です:
Using New CenteredMessageBox(Me, _
New Font(New FontFamily("Lucida Console"), 16, FontStyle.Bold))
MessageBox.Show("Test Text", "Test Title", MessageBoxButtons.YesNo, MessageBoxIcon.Question)
End Using
問題：
ウィンドウのすべてのコンテンツは、手動でサイズ変更/配置する必要があります。そうでない場合、テキストは次のようにトリミングされて表示されます。
そして、これは大きなフォントを使用した場合の結果です (テキスト コントロールのサイズを変更しました):
したがって、ウィンドウのサイズを変更し、ボタンを配置するために、どの位置とサイズが実際にフォントサイズに要素を持つかを計算する必要があります。それが私が求めていることです。どうすればそれができますか？私は数学があまり得意ではないので、単なる公式以上のものを必要とします.
要素：
私はこれらの要素を念頭に置いています：
- メッセージ ボックスのテキスト フォント サイズ。
- テキストを格納して表示する Messagebox 静的コントロール。
- メッセージボックス ボタン (1 つ、2 つ、または 3 つのボタンの組み合わせで、既定の位置が異なります)
- これらすべての要素を含むメッセージボックス ウィンドウ フォーム。
ボタン変数:
- メッセージ ボックス ウィンドウにボタンが 1 つしかない場合 (例: 「OK」)、中央に配置されますが、ボタンが 3 つある場合 (例: 「AbortRetryIgnore」)、最初のボタンは左下隅に配置され、2 番目のボタンは左下隅に配置されます。中央に、最後のボタンが右隅に、これについて説明する必要はないと思います。
私は算術の第一人者ではないので、必要な値がいくつか欠けていたら許してください。
Dim Text_width As Integer = 0
Dim Text_height As Integer = 0
Dim Text_Container_width As Integer = 0
Dim Text_Container_height As Integer = 0
' Don't calculate the exact size of messagebox window,
' just I think only needs to sum an extra size to a default messagebox rectangle
Dim Messagebox_window_extra_width As Integer = 0
Dim Messageboxwindow_extra_height As Integer = 0
' This represents the first button,
' in a messagebox button combination of 1, 2, or 3 buttons,
' this button could be displayed alligned at bottom-middle (as unique button),
' or could be alligned at bottom-left (as the first of 2 of 3 button combination).
Dim Button_1_Pos_X As Integer = 0
Dim Button_1_Pos_Y As Integer = 0
' This button represents the second button
' in a messagebox button combination of 2 or 3 buttons,
' the buton could exist or could not
' and could be displayed alligned at bottom-middle (in the middle of 3 buttons),
' this button could be displayed alligned at bottom-right (as second and last button).
Dim Button_2_Pos_X As Integer = 0
Dim Button_2_Pos_Y As Integer = 0
' This button represents the third button
' a messagebox button combination of 2 or 3 buttons,
' the buton could exist or could not
' and could be displayed alligned at bottom-right (as third and last button).
Dim Button_3_Pos_X As Integer = 0
Dim Button_3_Pos_Y As Integer = 0
これは私が自分でできることです。私はこの方法でメッセージボックスボタン要素を保存することをテストしています:
Dim button_Ok As IntPtr = GetDlgItem(hWnd, 1) ' The 'Ok' button.
Dim button_Cancel As IntPtr = GetDlgItem(hWnd, 2) ' the 'Cancel' button.
Dim button_Abort As IntPtr = GetDlgItem(hWnd, 3) ' the 'Abort' button.
Dim button_Retry As IntPtr = GetDlgItem(hWnd, 4) ' the 'Retry' button.
Dim button_Ignore As IntPtr = GetDlgItem(hWnd, 5) ' the 'Ignore' button.
Dim button_Yes As IntPtr = GetDlgItem(hWnd, 6) ' the 'Yes' button.
Dim button_No As IntPtr = GetDlgItem(hWnd, 7) ' the 'NO' button.
(メッセージボックスボタンの組み合わせに関係なく、常に同じアイテムインデックスを持っています)
メッセージ ボックス ウィンドウのサイズを変更するには、MoveWindow API を次のように使用します。
' This is to resize and positionate the messagebox window
MoveWindow(hWnd, _
frmRect.Left + (frmRect.Width - dlgRect.Right + dlgRect.Left) \ 2, _
frmRect.Top + (frmRect.Height - dlgRect.Bottom + dlgRect.Top) \ 2, _
(dlgRect.Right - dlgRect.Left) + Messagebox_window_extra_width, _
(dlgRect.Bottom - dlgRect.Top) + Messagebox_window_extra_height, True)
残りの要素 (テキスト コンテナー、ボタン) のサイズを変更するには、メッセージ ボックス フォームのサイズを変更した後、次のように SetWindowPos API を使用できます。
' Text container:
SetWindowPos(hText, 0, 70, 30, 1920, 1080, 0) ' Values are not perfect calculated but works fine
' Messagebox buttons:
' SetWindowPos(button_Ok, 0, 0, 0, 0, 0, 0)
' SetWindowPos(button_Cancel, 0, 0, 0, 0, 0, 0)
' SetWindowPos(button_Abort, 0, 0, 0, 0, 0, 0)
' SetWindowPos(button_Retry, 0, 0, 0, 0, 0, 0)
' SetWindowPos(button_Ignore, 0, 0, 0, 0, 0, 0)
' SetWindowPos(button_Yes, 0, 0, 0, 0, 0, 0)
' SetWindowPos(button_No, 0, 0, 0, 0, 0, 0)
メッセージボックスクラス
ここに、私が以前に言及したすべてのことを台無しにします：
' [ Centered MessageBox ]
'
' The author of the original code is Hans Passant: https://stackoverflow.com/questions/2576156/winforms-how-can-i-make-messagebox-appear-centered-on-mainform
'
' Examples :
'
' Using New CenteredMessageBox(Me, New Font(New FontFamily("Lucida Console"), Font.SizeInPoints, FontStyle.Bold))
' MessageBox.Show("Test Text", "Test Title", MessageBoxButtons.OK, MessageBoxIcon.Information)
' End Using
#Region " Centered MessageBox Class"
Imports System.Drawing
Imports System.Runtime.InteropServices
Imports System.Text
Imports System.Windows.Forms
Class CenteredMessageBox : Implements IDisposable
Private mTries As Integer = 0
Private mOwner As Form
Private mFont As Font
Dim Text_width As Integer = 0
Dim Text_height As Integer = 0
Dim Text_Container_width As Integer = 0
Dim Text_Container_height As Integer = 0
Dim Messagebox_window_extra_width As Integer = 0
Dim Messagebox_window_extra_height As Integer = 0
Dim Button_1_Pos_X As Integer = 0 ' "OK" Button
Dim Button_1_Pos_Y As Integer = 0 ' "OK" Button
Dim Button_2_Pos_X As Integer = 0 ' This button could not exist
Dim Button_2_Pos_Y As Integer = 0 ' This button could not exist
Dim Button_3_Pos_X As Integer = 0 ' This button could not exist
Dim Button_3_Pos_Y As Integer = 0 ' This button could not exist
' 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
Friend Declare Function SetWindowPos Lib "user32" (ByVal hwnd As IntPtr, ByVal hWndInsertAfter As IntPtr, ByVal x As Integer, ByVal y As Integer, ByVal cx As Integer, ByVal cy As Integer, ByVal wFlags As UInt32) As Boolean
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)
' Get the messagebox button elements
Dim button_Ok As IntPtr = GetDlgItem(hWnd, 1) ' The 'Ok' button.
Dim button_Cancel As IntPtr = GetDlgItem(hWnd, 2) ' the 'Cancel' button.
Dim button_Abort As IntPtr = GetDlgItem(hWnd, 3) ' the 'Abort' button.
Dim button_Retry As IntPtr = GetDlgItem(hWnd, 4) ' the 'Retry' button.
Dim button_Ignore As IntPtr = GetDlgItem(hWnd, 5) ' the 'Ignore' button.
Dim button_Yes As IntPtr = GetDlgItem(hWnd, 6) ' the 'Yes' button.
Dim button_No As IntPtr = GetDlgItem(hWnd, 7) ' the 'NO' button.
Dim frmRect As New Rectangle(mOwner.Location, mOwner.Size)
Dim dlgRect As RECT
GetWindowRect(hWnd, dlgRect)
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))
' Just here is an empty space where I can test some operations:
'
' Messagebox_window_extra_width = (mFont.Height \ mFont.Size) + (dlgRect.Right)
' Messagebox_window_extra_height = mFont.Height +
' This is to resize and positionate the messagebox window:
MoveWindow(hWnd, _
frmRect.Left + (frmRect.Width - dlgRect.Right + dlgRect.Left) \ 2, _
frmRect.Top + (frmRect.Height - dlgRect.Bottom + dlgRect.Top) \ 2, _
(dlgRect.Right - dlgRect.Left) + Messagebox_window_extra_width, _
(dlgRect.Bottom - dlgRect.Top) + Messagebox_window_extra_height, True)
' And this is to resize and positionate the rest elements:
'
' Text container:
SetWindowPos(hText, 0, 70, 30, 1920, 1080, 0)
'
' Messagebox buttons:
' SetWindowPos(button_Ok, 0, 0, 0, 0, 0, 0)
' SetWindowPos(button_Cancel, 0, 0, 0, 0, 0, 0)
' SetWindowPos(button_Abort, 0, 0, 0, 0, 0, 0)
' SetWindowPos(button_Retry, 0, 0, 0, 0, 0, 0)
' SetWindowPos(button_Ignore, 0, 0, 0, 0, 0, 0)
' SetWindowPos(button_Yes, 0, 0, 0, 0, 0, 0)
' SetWindowPos(button_No, 0, 0, 0, 0, 0, 0)
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
#End Region
アップデート
これは、@Grahamvs ソリューションを使用しようとしているものです。
Using New CenteredMessageBox(Me, New Font(New FontFamily("Lucida Console"), Font.SizeInPoints, FontStyle.Bold))
MessageBox.Show("Test Text", "Test Title", MessageBoxButtons.OK, MessageBoxIcon.Information)
End Using