Re: Moving MsgBox

Why not just design your own Message Box?

"LondonLad" <LondonLad@xxxxxxxxxxxxxxxxxxxxxxxxx> wrote in message
news:8FB8458D-770B-4218-9BE6-997C2D21A8F5@xxxxxxxxxxxxxxxx
Hi
I am using part of a Karl Peterson's program, see code below.
What I would like to do is have the MsgBox move to the corner of the
active
child form
I have tried many alterations to Karl's code without success can anyone
help
me please?

Parent Form
Private Sub MenuClose_Click()
End
End Sub

Private Sub MenuOpen_Click()
frmTest.Show vbModal, frmFront
End Sub

Child Form
Private Sub cmdMove_Click()
Dim msg As String
Dim Timeout As Long

msg = "This should appear centered " & _
"over the main form."
MsgBoxOver msg, , "Centered Over", _
Me.hWnd, Timeout
End Sub

Private Sub Form_Click()
Unload Me
End Sub

Private Sub Form_Load()
' Get rid if ugly default icon.
Set Me.Icon = Nothing
' Set initial coordinates so
' MsgBox ends up in lower-right
' of screen.
Text1.Text = "20000"
Text2.Text = "20000"
Text3.Text = "3000"
End Sub

Module
'
*************************************************************************
' Copyright ©2000-2005 Karl E. Peterson
' All Rights Reserved, http://vb.mvps.org/
'
*************************************************************************
' You are free to use this code within your own applications, but you
' are expressly forbidden from selling or otherwise distributing this
' source code, non-compiled, without prior written consent.
'
*************************************************************************
Option Explicit

' Win32 APIs
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 GetWindowRect Lib "user32" (ByVal hWnd As Long,
lpRect As RECT) 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 SetTimer Lib "user32" (ByVal hWnd As Long, ByVal
nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As
Long
Private Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal
nIDEvent As Long) As Long
Private Declare Function IsWindow Lib "user32" (ByVal hWnd As Long) As
Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA"
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As
Any)
As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA"
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As
Any)
As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As
Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () 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 Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

' Dismissal message
Private Const WM_CLOSE = &H10

' SetWindowsHook() codes
Private Const WH_MIN = (-1)
Private Const WH_MSGFILTER = (-1)
Private Const WH_JOURNALRECORD = 0
Private Const WH_JOURNALPLAYBACK = 1
Private Const WH_KEYBOARD = 2
Private Const WH_GETMESSAGE = 3
Private Const WH_CALLWNDPROC = 4
Private Const WH_CBT = 5
Private Const WH_SYSMSGFILTER = 6
Private Const WH_MOUSE = 7
Private Const WH_HARDWARE = 8
Private Const WH_DEBUG = 9
Private Const WH_SHELL = 10
Private Const WH_FOREGROUNDIDLE = 11
Private Const WH_MAX = 11

' GetSystemMetrics() constants
Private Const SM_CXSCREEN As Long = 0
Private Const SM_CYSCREEN As Long = 1
Private Const SM_XVIRTUALSCREEN As Long = 76
Private Const SM_YVIRTUALSCREEN As Long = 77
Private Const SM_CXVIRTUALSCREEN As Long = 78
Private Const SM_CYVIRTUALSCREEN As Long = 79
Private Const SM_CMONITORS As Long = 80

' CBT Hook Codes
Private Const HCBT_MOVESIZE = 0
Private Const HCBT_MINMAX = 1
Private Const HCBT_QS = 2
Private Const HCBT_CREATEWND = 3
Private Const HCBT_DESTROYWND = 4
Private Const HCBT_ACTIVATE = 5
Private Const HCBT_CLICKSKIPPED = 6
Private Const HCBT_KEYSKIPPED = 7
Private Const HCBT_SYSCOMMAND = 8
Private Const HCBT_SETFOCUS = 9

' HCBT_ACTIVATE structure pointed to by lParam
Private Type CBTACTIVATESTRUCT
fMouse As Long 'BOOL
hWndActive As Long
End Type

' Private module vars
Private m_hHook As Long
Private m_TmrID As Long
Private m_hWnd As Long
Private m_hWndOver As Long
Private m_Top As Long
Private m_Left As Long

Public Function MsgBoxOver(ByVal Prompt As String, Optional ByVal Buttons
As
VbMsgBoxStyle = vbOKOnly, Optional Title As String, Optional ByVal
hWndOver
As Long, Optional ByVal Timeout As Long) As VbMsgBoxResult
' Cache hWndOver value.
If hWndOver Then
m_hWndOver = hWndOver
Else
m_hWndOver = GetDesktopWindow()
End If

' Set title using proper default, if none supplied.
#If VBA Then
If Title = "" Then Title = Application.Name 'VBA
#Else
If Title = "" Then Title = App.Title 'VB
#End If

' Set the CBT hook.
m_hHook = SetWindowsHookEx(WH_CBT, AddressOf CBTProcOver, 0&,
GetCurrentThreadId())

' Display the message box.
MsgBoxOver = MsgBox(Prompt, Buttons, Title)
End Function

Private Function CBTProcOver(ByVal nCode As Long, ByVal wParam As Long,
ByVal lParam As Long) As Long
Dim r1 As RECT, r2 As RECT, r3 As RECT
Dim x, y, z
' We only want to react to activations.
If nCode = HCBT_ACTIVATE Then
' Handle to be activated is in wParam.
' VBA: Test to be sure we have MsgBox.
If IsMsgBox(wParam) Then
m_hWnd = wParam

' Get width/height of msgbox.
Call GetWindowRect(m_hWnd, r1)
' Get coordinates for owner window.
Call GetWindowRect(m_hWndOver, r2)
' Adjust msgbox coordinates.
r3 = AlignRects(r1, r2)

' Optionally, validate new coordinates
' to insure they are on-screen.
Call ValidateCoords(r3)

' Move to new position.
Call MoveWindow(m_hWnd, r3.Left, r3.Top, r3.Right - r3.Left,
r3.Bottom - r3.Top, True)

' Hook no longer needed.
Call UnhookWindowsHookEx(m_hHook)
End If
End If
End Function

' **********************************************
' Other private methods
' **********************************************
Private Function AlignRects(rOver As RECT, rUnder As RECT) As RECT
' Returns rectangle aligned such that rOver is
' centered perfectly above rUnder.
AlignRects.Left = rUnder.Left _
+ ((rUnder.Right - rUnder.Left) \ 2) _
- ((rOver.Right - rOver.Left) \ 2)
AlignRects.Right = AlignRects.Left + (rOver.Right - rOver.Left)

AlignRects.Top = rUnder.Top _
+ ((rUnder.Bottom - rUnder.Top) \ 2) _
- ((rOver.Bottom - rOver.Top) \ 2)
AlignRects.Bottom = AlignRects.Top + (rOver.Bottom - rOver.Top)
End Function

Public Function IsMsgBox(ByVal hWnd As Long) As Boolean
Dim Class As String
Const MaxLen As Long = 256
Const Target As String = "#32770"
' Retrieve classname of passed window.
Class = String$(MaxLen, 0)
If GetClassName(hWnd, Class, MaxLen) Then
Class = Left$(Class, InStr(Class, vbNullChar) - 1)
IsMsgBox = (StrComp(Class, Target, vbTextCompare) = 0)
End If
End Function

Private Sub ValidateCoords(r As RECT)
Dim dsktop As RECT
Dim Width As Long
Dim Height As Long
Dim x, y

With dsktop
' Get coordinates for current desktop.
' Branch based on number of display monitors.
If GetSystemMetrics(SM_CMONITORS) > 1 Then
.Left = GetSystemMetrics(SM_XVIRTUALSCREEN)
.Top = GetSystemMetrics(SM_YVIRTUALSCREEN)
.Right = GetSystemMetrics(SM_CXVIRTUALSCREEN) + .Left
.Bottom = GetSystemMetrics(SM_CYVIRTUALSCREEN) + .Top
Else
.Left = 0
.Top = 0
.Right = GetSystemMetrics(SM_CXSCREEN)
.Bottom = GetSystemMetrics(SM_CYSCREEN)
End If
Width = .Right - .Left
Height = .Bottom - .Top
x = Width
y = Height

' Check that we're not off left edge.
If r.Left < .Left Then
r.Right = r.Right - r.Left
r.Left = .Left
End If

' Check that we're not over the top.
If r.Top < .Top Then
r.Bottom = r.Bottom - r.Top
r.Top = .Top
End If

' Check right/bottom edges.
If r.Right > Width Then
r.Left = Width - (r.Right - r.Left)
r.Right = Width
End If
If r.Bottom > Height Then
r.Top = Height - (r.Bottom - r.Top)
r.Bottom = Height
End If
End With
End Sub




.