Visual Basic Hook Routines

SetWindowsHookEx: Centre the API Message Box
     
Posted:   Thursday April 11, 2002
Updated:   Monday December 26, 2011
     
Applies to:   VB5, VB6
Developed with:   VB6, Windows 2000
OS restrictions:   None
Author:   VBnet - Randy Birch
     

Related:  

SetWindowsHookEx: 'Self-Closing' Message Box using a VB Timer
SetWindowsHookEx: 'Self-Closing' Message Box using SetTimer
SetWindowsHookEx: Detect Caps/Numlock/Scrollock via System-wide Keyboard Hook
SetWindowsHookEx: Customize the API Message Box
SetWindowsHookEx: Trapping Special Key Events using Low Level Hooks
MessageBoxEx: Displaying an API-created Message Box
       
 Prerequisites
VB5 / VB6.

Like the other MessageBox demos, this one centres on centering, so to speak. Using the same hook code from the timed and modify demos, and the same centering code as the GetOpenFileName hook demo, the message box created via API can be placed wherever you want ... in this demo centered in the parent.

The technique shown here is easily ported to any of the other hook demos above. Note too that this demo makes use of VB5 and VB6's ability to override existing VB functions by providing new methods using the same name ... i.e. this demo replaces VB's intrinsic MsgBox function by naming the API method called "MsgBox".

For a complete discussion of hooking, see SetWindowsHookEx: Customize the API Message Boxabove.

 BAS Module Code
Place the following code into the general declarations area of a bas module:

Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright 1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'misc API constants
Private Const WH_CBT = 5
Private Const GWL_HINSTANCE = (-6)
Private Const HCBT_ACTIVATE = 5

'UDT for passing data through the hook
Private Type MSGBOX_HOOK_PARAMS
   hwndOwner   As Long
   hHook       As Long
End Type

Private Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type

'need this declared at module level as
'it is used in the call and the hook proc
Private mhp As MSGBOX_HOOK_PARAMS

Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long

Private Declare Function GetWindowLong Lib "user32" _
   Alias "GetWindowLongA" _
  (ByVal hwnd As Long, _
   ByVal nIndex As Long) As Long

Private 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
   
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 UnhookWindowsHookEx Lib "user32" _
   (ByVal hHook As Long) As Long

Private Declare Function MoveWindow Lib "user32" _
  (ByVal hwnd As Long, _
   ByVal X As Long, _
   ByVal Y As Long, _
   ByVal nWidth As Long, _
   ByVal nHeight As Long, _
   ByVal bRepaint As Long) As Long
   
Private Declare Function GetWindowRect Lib "user32" _
  (ByVal hwnd As Long, _
   lpRect As RECT) As Long
   
Public Function Msgbox(sPrompt As String, _
                       Optional dwStyle As Long, _
                       Optional sTitle As String) As Long

  'replaces VB's built in MsgBox function in VB5/6
  
   Dim hInstance As Long
   Dim hThreadId As Long
   
   If dwStyle = 0 Then dwStyle = vbOKOnly
   If Len(sTitle) = 0 Then sTitle = "VBnet Messagebox Demo"
   
  'Set up the hook
   hInstance = GetWindowLong(Form1.hwnd, GWL_HINSTANCE)
   hThreadId = GetCurrentThreadId()

  'set up the MSGBOX_HOOK_PARAMS values
  'By specifying a Windows hook as one
  'of the params, we can intercept messages
  'sent by Windows and thereby manipulate
  'the dialog
   With MHP
      .hwndOwner = Form1.hwnd
      .hHook = SetWindowsHookEx(WH_CBT, _
                                AddressOf MsgBoxHookProc, _
                                hInstance, hThreadId)
   End With
   
  'call the MessageBox API and return the
  'value as the result of this function
   Msgbox = MessageBox(Form1.hwnd, sPrompt, sTitle, dwStyle)

End Function


Public Function MsgBoxHookProc(ByVal uMsg As Long, _
                               ByVal wParam As Long, _
                               ByVal lParam As Long) As Long
      
   Dim rc As RECT
   
  'temporary vars for demo
   Dim newLeft As Long
   Dim newTop As Long
   Dim dlgWidth As Long
   Dim dlgHeight As Long
   Dim scrWidth As Long
   Dim scrHeight As Long
   Dim frmLeft As Long
   Dim frmTop As Long
   Dim frmWidth As Long
   Dim frmHeight As Long
   Dim hwndMsgBox As Long
   
  'When the message box is about to be shown,
  'centre the dialog
   If uMsg = HCBT_ACTIVATE Then
   
     'in a HCBT_ACTIVATE message, wParam holds
     'the handle to the messagebox
      hwndMsgBox = wParam
              
     'Just as was done in other API hook demos,
     'position the dialog centered in the calling
     'parent form
     
      Call GetWindowRect(hwndMsgBox, rc)
      
      frmLeft = Form1.Left \ Screen.TwipsPerPixelX
      frmTop = Form1.Top \ Screen.TwipsPerPixelY
      frmWidth = Form1.Width \ Screen.TwipsPerPixelX
      frmHeight = Form1.Height \ Screen.TwipsPerPixelX

      dlgWidth = rc.Right - rc.Left
      dlgHeight = rc.Bottom - rc.Top
      
      scrWidth = Screen.Width \ Screen.TwipsPerPixelX
      scrHeight = Screen.Height \ Screen.TwipsPerPixelY
      
      newLeft = frmLeft + ((frmWidth - dlgWidth) \ 2)
      newTop = frmTop + ((frmHeight - dlgHeight) \ 2)
      
      Call MoveWindow(hwndMsgBox, newLeft, newTop, dlgWidth, dlgHeight, True)
      
      
     'done with the dialog so release the hook
      UnhookWindowsHookEx MHP.hHook
               
   End If
   
  'return False to let normal
  'processing continue
   MsgBoxHookProc = False

End Function
 Form Code
Add a text box (Text1) and a command button (Command1) to a form, along with the following code:

Option Explicit

Private Sub Command1_Click()
  
  'Display the API message box
   Dim sTitle As String
   Dim sPrompt As String
   Dim dwStyle As Long
   
   sTitle = "VBnet MessageBox Hook Demo"
   sPrompt = "This is a demo of the MessageBox API showing how to hook" & vbCrLf & _
             "the dialog and centre it with respect to the parent form."
   dwStyle = vbAbortRetryIgnore Or vbInformation

   Select Case Msgbox(sPrompt, dwStyle, sTitle)
      Case vbRetry:  Text1.Text = "Retry button pressed"
      Case vbAbort:  Text1.Text = "Abort button pressed"
      Case vbIgnore: Text1.Text = "Ignore button pressed"
   End Select
     
End Sub
 Comments

 
 

PayPal Link
Make payments with PayPal - it's fast, free and secure!

 
 
 
 

Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy

 

Hit Counter