by Waty Thierry (60 Submissions)
Category: Windows System Services
Compatability: Visual Basic 4.0 (32-bit)
Difficulty: Unknown Difficulty
Originally Published: Tue 13th April 1999
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Replacement for the standard VB messagebox function
VBcoders
' * Programmer Name : John Timney
' * Web Site : www.geocities.com/ResearchTriangle/6311/
' * E-Mail : [email protected]
' * Date : 29/01/99
' * Time : 16:31
' * Module Name : MsgBox_Module
' * Module Filename : MsgBox.bas
' **********************************************************************
' * Comments :
' * This project is a replacement for the standard VB messagebox function. It allows the programmer to assign,
' * re-assign the owner/parent of the messagebox, thus allowing code processing to continue even though
' * message boxes are on screen. It also accepts parameters to position the messagebox anywhere on the
' * screen. Excellent solution for event driven code, allowing
' * events to be raised when message boxes have the focus.
' * Author: John Timney
' *
' * TIMsgbox "this messagebox has not been re-positioned and assumes a parent of the desktop"
' *
' * TIMsgbox "this msgbox has been positioned at 100,100 with this form as the parent", , , Me, True, 100, 100
' *
' * TIMsgbox "this msgbox has not been positioned and is given a parent of the active window", , , GetForegroundWindow
' *
' * TIMsgbox "this msgbox has not been positioned and is given a parent of the Desktop window", , , GetDesktopWindow
' *
' * TIMsgbox "this msgbox has not been positioned and is given a parent of the Active window", , , GetActiveWindow
' *
' *
' **********************************************************************
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Type HookParms
WindowOwner As Long
xPos As Long
yPos As Long
hHook As Long
End Type
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function GetDesktopWindow Lib "user32" () As Long
Public Declare Function GetActiveWindow Lib "user32" () As Long
Public Declare Function GetForegroundWindow Lib "user32" () As Long
Public Declare Function IsWindow Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Public 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
Public 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
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Public Const GWL_HINSTANCE = (-6)
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOZORDER = &H4
Public Const SWP_NOACTIVATE = &H10
Public Const HCBT_ACTIVATE = 5
Public Const WH_CBT = 5
Public Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
Public Const MB_APPLMODAL = &H0&
Public Const MB_SYSTEMMODAL = &H1000&
Public Const MB_TASKMODAL = &H2000&
Public MessParms As HookParms '# set up the MessParms as a public type of type HookParms
Public Function TIMsgbox(ByVal sCaption As String, Optional ByVal lParms As VbMsgBoxStyle = vbInformation, _
Optional ByVal sTitle As Variant = "Timneys Tools", Optional ByVal lOwner As Variant, _
Optional ByVal bPositionBox As Boolean = False, Optional ByVal xVal As Long = 0, Optional ByVal yVal As Long = 0) As Long
' * Programmer Name : John Timney
' * Web Site : www.geocities.com/ResearchTriangle/6311/
' * E-Mail : [email protected]
' * Date : 29/01/99
' * Time : 16:30
' * Module Name : Module2
' * Module Filename : msgboxposition.txt
' * Procedure Name : TIMsgbox
' * Parameters :
' * ByVal sCaption As String
' * Optional ByVal lParms As VbMsgBoxStyle = vbInformation
' * Optional ByVal sTitle As Variant = "Timneys Tools"
' * Optional ByVal lOwner As Variant
' * Optional ByVal bPositionBox As Boolean = False
' * Optional ByVal xVal As Long = 0
' * Optional ByVal yVal As Long = 0
' **********************************************************************
' * Comments :
' * This project is a replacement for the standard VB messagebox function. It allows the programmer to assign,
' * re-assign the owner/parent of the messagebox, thus allowing code processing to continue even though
' * message boxes are on screen. It also accepts parameters to position the messagebox anywhere on the
' * screen. Excellent solution for event driven code, allowing
' * events to be raised when message boxes have the focus.
' * Author: John Timney
' *
' *
' **********************************************************************
On Error GoTo local_error
If Len(Trim(sCaption)) = 0 Then '# determine if caption was passed
Exit Function
End If
If IsMissing(lOwner) Then
lOwner = "&h" & Hex(0) '# convert to hex
Else
lOwner = lOwner.hwnd '# if it cant be given a window handle, then its already a window handle
End If
lParms = "&h" & (Hex(lParms))
'# and now determine where the message box should be positioned
Dim hInst As Long
Dim Thread As Long
'Set up the CBT hook
hInst = GetWindowLong(lOwner, GWL_HINSTANCE)
Thread = GetCurrentThreadId()
'# set up the hookparms type values
'# this is used by the hooker to
'# intercept the windows messages
'# and then activate the hook against the function HookProc
MessParms.WindowOwner = lOwner
MessParms.xPos = IIf(bPositionBox = True, xVal, 0)
MessParms.yPos = IIf(bPositionBox = True, yVal, 0)
MessParms.hHook = SetWindowsHookEx(WH_CBT, AddressOf HookProc, hInst, Thread) '# create the hook
'# end hookparms set
TIMsgbox = MessageBox(lOwner, sCaption, sTitle, lParms + MB_TASKMODAL) '# invoke API with specific owner, and modal state
Exit Function
local_error:
' the caller passed a window handle in - oops
' oh well, lets use it anyway as a parent
Resume Next
End Function
Private Function HookProc(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim rectForm As RECT, rectMsg As RECT
Dim x As Long, y As Long
Debug.Print "hooked in at " & Time
'On HCBT_ACTIVATE, show the MsgBox centered over Form1
If lMsg = HCBT_ACTIVATE Then
'Get the coordinates of the form and the message box so that
'you can determine where the center of the form is located
'# get the message box hookparms values, this is the only safe
'# way to pass things to a windows proc while hooked
'# evaluate the type values
'# re-evaluate the owner of the message - must have a parent
MessParms.WindowOwner = IIf(MessParms.WindowOwner = 0, GetDesktopWindow, MessParms.WindowOwner)
GetWindowRect MessParms.WindowOwner, rectForm
GetWindowRect wParam, rectMsg
x = IIf(Not MessParms.xPos = 0, MessParms.xPos, rectForm.Left + (rectForm.Right - rectForm.Left) / 2) - _
((rectMsg.Right - rectMsg.Left) / 2)
y = IIf(Not MessParms.yPos = 0, MessParms.yPos, rectForm.Top + (rectForm.Bottom - rectForm.Top) / 2) - _
((rectMsg.Bottom - rectMsg.Top) / 2)
'Position the msgbox
SetWindowPos wParam, 0, x, y, 0, 0, _
SWP_NOSIZE Or SWP_NOZORDER Or SWP_NOACTIVATE
'Release the CBT hook
UnhookWindowsHookEx MessParms.hHook
Debug.Print "hooked out at " & Time
End If
HookProc = False
End Function
