【VB.NET】中央に表示されません
-------------------------------------------------------
[Win32Nativeクラス]
---------
Module Win32Native
Private Const GWL_HINSTANCE As Integer = -6
<DllImport("user32.dll")>
Private Function GetWindowLong(ByVal hWnd As IntPtr, ByVal nIndex As Integer) As IntPtr
End Function
Public Function GetWindowHInstance(ByVal hWnd As IntPtr) As IntPtr
Return GetWindowLong(hWnd, GWL_HINSTANCE)
End Function
<DllImport("kernel32.dll")>
Public Function GetCurrentThreadId() As IntPtr
End Function
Public Const WH_CBT As Integer = 5
Public Const HCBT_ACTIVATE As Integer = 5
<DllImport("user32.dll")>
Private Function SetWindowsHookEx(ByVal idHock As Integer, ByVal lpfn As HOOKPROC,
ByVal hInstance As IntPtr, ByVal threadId As IntPtr) As IntPtr
End Function
Public Function SetWindowsHookEx(ByVal lpfn As HOOKPROC, ByVal hInstance As IntPtr,
ByVal threadId As IntPtr) As IntPtr
Return SetWindowsHookEx(WH_CBT, lpfn, hInstance, threadId)
End Function
<DllImport("user32.dll")>
Public Function UnhookWindowsHookEx(ByVal hHook As IntPtr) As Boolean
End Function
<DllImport("user32.dll")>
Public Function CallNextHookEx(ByVal hHook As IntPtr, ByVal nCode As Integer,
ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr
End Function
Public Delegate Function HOOKPROC(ByVal nCode As Integer, wParam As Integer, lParam As IntPtr) As IntPtr
<DllImport("user32.dll")>
Public Function GetWindowRect(ByVal hWnd As IntPtr, ByRef lpRect As RECT) As Boolean
End Function
Public Structure RECT
Public Left, Top, Right, Bottom As Integer
Public ReadOnly Property Width As Integer
Get
Return Me.Right - Me.Right
End Get
End Property
Public ReadOnly Property Height As Integer
Get
Return Me.Bottom - Me.Top
End Get
End Property
End Structure
Public Function GetWindowRect(hWnd As IntPtr) As RECT
Dim rc As RECT
GetWindowRect(hWnd, rc)
Return rc
End Function
<DllImport("user32.dll")>
Private Function SetWindowPos(ByVal hWnd As IntPtr, ByVal hWndInsertAfter As Integer,
ByVal x As Integer, ByVal y As Integer,
ByVal cx As Integer, ByVal cy As Integer,
ByVal uFlags As UInteger) As Boolean
End Function
Private Const SWP_NOSIZE As UInteger = &H1 '0x0001;
Private Const SWP_NOZORDER As UInteger = &H4 '0x0004;
Private Const SWP_NOACTIVATE As UInteger = &H10 '0x0010;
Private Function SetWindowPos(ByVal hWnd As IntPtr,
ByVal x As Integer, ByVal y As Integer) As Boolean
Dim flags = SWP_NOSIZE Or SWP_NOZORDER Or SWP_NOACTIVATE
Return SetWindowPos(hWnd, 0, x, y, 0, 0, flags)
End Function
End Module
---------
[CustomMessageBoxクラス]
---------
Public Class CustomMessageBox
''' <summary>オーナハンドル</summary>
Private Shared hOwner As IntPtr = IntPtr.Zero
''' <summary>フックハンドル</summary>
Private Shared hHook As IntPtr = IntPtr.Zero
Public Shared Function Show(ByVal owner As IWin32Window,
ByVal text As String, ByVal caption As String,
ByVal buttons As MessageBoxButtons, ByVal icon As MessageBoxIcon) As DialogResult
Dim hOwner = owner.Handle
Dim hInstance = Win32Native.GetWindowHInstance(owner.Handle)
Dim threadId = Win32Native.GetCurrentThreadId()
Dim hHook = Win32Native.SetWindowsHookEx(New Win32Native.HOOKPROC(AddressOf HookProc), hInstance, threadId)
Return MessageBox.Show(owner, text, caption, buttons, icon)
End Function
Private Shared Function HookProc(ByVal nCode As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) _
As IntPtr
If nCode = Win32Native.HCBT_ACTIVATE Then
' オーナーウィンドウとメッセージボックスの領域を取得
Dim rcOwner = Win32Native.GetWindowRect(hOwner)
Dim rcMsgBox = Win32Native.GetWindowRect(wParam)
' メッセージボックスをオーナーウィンドウの中央位置に移動
Dim x = rcOwner.Left + (rcOwner.Width - rcMsgBox.Width) / 2
Dim y = rcOwner.Top + (rcOwner.Height - rcMsgBox.Height) / 2
'フック解除
Win32Native.UnhookWindowsHookEx(hHook)
hHook = CType(0, IntPtr)
End If
Return Win32Native.CallNextHookEx(hHook, nCode, wParam, lParam)
End Function
End Class
---------
-------------------------------------------------------
