• Home
 · 
• Windows System Services
 · 
• Message box with no parent

Message box with no parent

Message box with no parent

Rate Message box with no parent

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

' * 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         :
' *   Message box with no parent
' **********************************************************************

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