/ Snippet Library - View Code

Visual Basic / Miscellaneous / MsgBox positioning

Snippet details

ID: 392

Viewed: 1246

Added: 2002-08-19

Version:

Snippets in this catagory
Show Printable Version

MsgBox positioning

General Details

Snippet uploaded by: snippet

Email : webmaster@snippetlibrary.com

Snippet By: Unknown

Snippet By:	Unknown
Declarations
Highlight Allnone
Code
Highlight All' 'In a Module... ' Public Enum StartupPos CenterScreen CenterOwner Custom End Enum Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Private Type CWPSTRUCT lParam As Long wParam As Long message As Long hwnd As Long End Type Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long Private Const SWP_FRAMECHANGED = &H20 Private Const SWP_NOSIZE = &H1 Private Const SWP_NOZORDER = &H4 Private Const GWL_WNDPROC = (-4) Private Const WH_CALLWNDPROC = 4 Private Const WM_CREATE = &H1 Private Const WM_INITDIALOG = &H110 Private MSGBOXEX_X As Integer Private MSGBOXEX_Y As Integer Private MSGBOXEX_STARTUP As StartupPos Private lPrevWnd As Long Private lHook As Long Private Function SubMsgBox(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Dim tRECT As RECT Dim tOWNER As RECT If Msg = WM_INITDIALOG Then 'Reposition the MsgBox is Neccessary.. If MSGBOXEX_STARTUP = CenterOwner Then Call GetWindowRect(GetParent(hwnd), tOWNER) Else Call GetWindowRect(0, tOWNER) End If Call GetWindowRect(hwnd, tRECT) Select Case MSGBOXEX_STARTUP Case Custom If MSGBOXEX_X = -1 Then 'Center Horz tRECT.Left = ((Screen.Width / Screen.TwipsPerPixelX) - (tRECT.Right - tRECT.Left)) / 2 Else 'Position Horz tRECT.Left = MSGBOXEX_X End If If MSGBOXEX_Y = -1 Then 'Center Vert tRECT.Top = ((Screen.Height / Screen.TwipsPerPixelY) - (tRECT.Bottom - tRECT.Top)) / 2 Else 'Position Vert tRECT.Top = MSGBOXEX_Y End If Call SetWindowPos(hwnd, 0, tRECT.Left, tRECT.Top, 0, 0, SWP_NOSIZE Or SWP_NOZORDER Or SWP_FRAMECHANGED) Case CenterOwner tRECT.Left = tOWNER.Left + (((tOWNER.Right - tOWNER.Left) - (tRECT.Right - tRECT.Left)) / 2) tRECT.Top = tOWNER.Top + (((tOWNER.Bottom - tOWNER.Top) - (tRECT.Bottom - tRECT.Top)) / 2) Call SetWindowPos(hwnd, 0, tRECT.Left, tRECT.Top, 0, 0, SWP_NOSIZE Or SWP_NOZORDER Or SWP_FRAMECHANGED) End Select 'Remove the Messagebox Subclassing Call SetWindowLong(hwnd, GWL_WNDPROC, lPrevWnd) End If SubMsgBox = CallWindowProc(lPrevWnd, hwnd, Msg, wParam, ByVal lParam) End Function Private Function HookWindow(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Dim tCWP As CWPSTRUCT Dim sClass As String 'This is where you need to Hook the Messagebox CopyMemory tCWP, ByVal lParam, Len(tCWP) Select Case tCWP.message Case WM_CREATE sClass = Space(255) sClass = Left(sClass, GetClassName(tCWP.hwnd, ByVal sClass, 255)) If sClass = "#32770" Then 'Subclass the Messagebox as it's created lPrevWnd = SetWindowLong(tCWP.hwnd, GWL_WNDPROC, AddressOf SubMsgBox) End If End Select HookWindow = CallNextHookEx(lHook, nCode, wParam, ByVal lParam) End Function Public Function MsgBoxEx(Prompt, optional X = -1, optional Y = -1, optional StartupPosition As StartupPos = CenterScreen, optional Buttons As VbMsgBoxStyle = vbOKOnly, optional Title, optional HelpFile, optional Context) As VbMsgBoxResult MSGBOXEX_X = X MSGBOXEX_Y = Y MSGBOXEX_STARTUP = StartupPosition 'set a Thread Message Hook.. lHook = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf HookWindow, App.hInstance, App.ThreadID) MsgBoxEx = MsgBox(Prompt, Buttons, Title, HelpFile, Context) 'Remove the Hook Call UnhookWindowsHookEx(lHook) End Function

No Reviews to show