Not a Member Yet,
Click here to Register
How do you like the new design?






ID: 392
Viewed: 2888
Added: Aug 19, 2002
Version:
Snippet uploaded by: snippet
Written By: Unknown
Demo: Sorry, no demo



User Rated at: 0 Stars
Rate This:

Thank you for your vote. Please wait...

It appears you already voted for this snippet

It appears your vote value was empty

MsgBox positioning

Highlight all by clicking in box
<!---Declaration--->
none

Highlight All
<!---Code--->
'
'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 Comments to show

Please completely fill out the form below if you want to review this snippet. All reviews are subject to validation.


Replying to a Comment...


Adding your comment. Please wait...

Thanks for adding your comment!. After further review it will be added.

There was a problem adding your comment. Please try again.

Please complete all the fields in the form before sending.

© 2002 - 2017 snippetlibrary.com All Rights Reserved. Conditions