Which is the mathematic formula to calculate the size and positions for this window?

∥☆過路亽.° 提交于 2019-12-01 14:15:45
Grahamvs

This worked for me:

I changed:

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

to

 Declare Auto Function SendMessage Lib "user32.dll" (ByVal hWnd As IntPtr, ByVal msg As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr

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

        ' Get text
        Dim WM_GETTEXT As Integer = &HD

        ' Alloc memory for the buffer that recieves the text
        Dim Hndl As IntPtr = Marshal.AllocHGlobal(200)

        ' Send The WM_GETTEXT Message
        Dim NumText As Integer = SendMessage(hText, WM_GETTEXT, 200, Hndl)

        ' Copy the characters from the unmanaged memory to a managed string
        Dim MSGText As String = Marshal.PtrToStringUni(Hndl)


        ' Measure the text
        Dim TextSize As SizeF
        Using G As Graphics = mOwner.CreateGraphics
            TextSize = G.MeasureString(MSGText & "MMM", mFont)
        End Using

and changed MoveWindow to:

MoveWindow(hWnd, frmRect.Left + (frmRect.Width - dlgRect.Right + dlgRect.Left) \ 2, frmRect.Top + (frmRect.Height - dlgRect.Bottom + dlgRect.Top) \ 2, CInt(TextSize.Width) + Messagebox_window_extra_width, (dlgRect.Bottom - dlgRect.Top) + Messagebox_window_extra_height, True)

Hope this helps

Edit: Here is the full code

' [ Centered MessageBox ]

'

' The author of the original code is Hans Passant: http://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(ByVal hWnd As IntPtr, ByVal lp As IntPtr) As Boolean



    <DllImport("user32.dll")> _

    Private Shared Function EnumThreadWindows(ByVal tid As Integer, ByVal callback As EnumThreadWndProc, ByVal 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(ByVal hWnd As IntPtr, ByVal buffer As StringBuilder, ByVal buflen As Integer) As Integer

    End Function



    <DllImport("user32.dll")> _

    Private Shared Function GetDlgItem(ByVal hWnd As IntPtr, ByVal item As Integer) As IntPtr

    End Function



    '<DllImport("user32.dll")> _

    'Private Shared Function SendMessage(ByVal hWnd As IntPtr, ByVal msg As Integer, ByVal wp As IntPtr, ByVal lp As IntPtr) As IntPtr

    'End Function



    <DllImport("user32.dll")> _

    Shared Function GetWindowRect(ByVal hWnd As IntPtr, ByRef rc As RECT) As Boolean

    End Function



    <DllImport("user32.dll")> _

    Shared Function MoveWindow(ByVal hWnd As IntPtr, ByVal x As Integer, ByVal y As Integer, ByVal w As Integer, ByVal h As Integer, ByVal repaint As Boolean) As Boolean

    End Function



    Declare Auto Function SendMessage Lib "user32.dll" (ByVal hWnd As IntPtr, ByVal msg As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr



    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(ByVal owner As Form, Optional ByVal 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(ByVal hWnd As IntPtr, ByVal 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))



            ' Get text

            Dim WM_GETTEXT As Integer = &HD



            ' Alloc memory for the buffer that recieves the text

            Dim Hndl As IntPtr = Marshal.AllocHGlobal(200)



            ' Send The WM_GETTEXT Message

            Dim NumText As Integer = SendMessage(hText, WM_GETTEXT, 200, Hndl)



            ' Copy the characters from the unmanaged memory to a managed string

            Dim MSGText As String = Marshal.PtrToStringUni(Hndl)





            ' Measure the text

            Dim TextSize As SizeF

            Using G As Graphics = mOwner.CreateGraphics

                TextSize = G.MeasureString(MSGText & "MMM", mFont)

            End Using



            ' 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)

            MoveWindow(hWnd, frmRect.Left + (frmRect.Width - dlgRect.Right + dlgRect.Left) \ 2, frmRect.Top + (frmRect.Height - dlgRect.Bottom + dlgRect.Top) \ 2, Math.Max(CInt(TextSize.Width), 200) + 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
易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!