[COLOR=blue]'General Note: notes are above the line of code to which they apply.
Option Explicit
' Window size and position constants
Private Const ICON_WIDTH As Integer = 32
Private Const BTN_WIDTH As Integer = 75
Private Const BTN_HEIGHT As Integer = 23
Private Const BTN_SPACER As Integer = 6 ' Space between 2 buttons
Private Const STW_OFFSET As Integer = 12 ' Standard window offset, minimum distance one window can be from
' the edge of its container
' SendMessage constants that we will use
Private Const WM_SETFONT = &H30
Private Const WM_GETTEXT = &HD
' Necessary constants for hooking
Private Const HCBT_CREATEWND = 3
Private Const HCBT_ACTIVATE = 5
Private Const WH_CBT = 5
' Working variables that require global scope in hooking module
Private hHook As Long
Private myFont As IFont
Private cPrompt As String
Private hwndStatic As Long
Private ButtonHandles() As Long
Private xPixels As Long
Private yPixels As Long
Private isIcon As Boolean
' The API declarations we need
Private Type SIZE
cx As Long
cy As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
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
'GETTEXT needs a String argument, SETFONT needs an Any argument, hence 2 declarations for SendMessage
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 SendMessageS Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) 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 GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
' Wrapper for the normal MsgBox function
Public Function myMsgBox(Prompt As String, Buttons As VbMsgBoxStyle, ByVal fSize As Integer, ByVal fBold As Boolean, ByVal fItalic As Boolean, ByVal fULine As Boolean, fFaceName As String, Optional Title As String, Optional HelpFile As String, Optional Context As Long, Optional x As Long, Optional y As Long) As Long
'x and y arguments are optional and are in twips. If not specified, msgbox will use default window sizes
'and positions, which work fine if you are using default font sizes. If you aren't they may not.
cPrompt = Prompt
Set myFont = New StdFont
myFont.SIZE = fSize ' We can play around with the font to our heart's content here, all in a VB-friendly way
myFont.Bold = fBold
myFont.Italic = fItalic
myFont.Underline = fULine
myFont.Name = fFaceName
'Convert x and y arguments to pixels from twips. (Twips are the same size no matter what the screen
'resolution; pixels aren't.)
If Not IsMissing(x) Then
xPixels = Int(x / Screen.TwipsPerPixelX)
End If
If Not IsMissing(y) Then
yPixels = Int(y / Screen.TwipsPerPixelY)
End If
hHook = SetWindowsHookEx(WH_CBT, AddressOf CBTProc, App.hInstance, 0)
'This will call CBTProc, passing the handle of the MsgBox window to the wParam argument.
myMsgBox = MsgBox(Prompt, Buttons, Title, HelpFile, Context)
End Function
Private Function CBTProc(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim i As Integer
Dim statX As Integer 'X dimension of static (text) window
Dim statY As Integer 'Y dimension of same
Dim cLeft As Integer 'Current Left value for current button, used to position buttons along x axis
Dim rc As RECT 'Used with GetClientRect
If lMsg = HCBT_ACTIVATE Then
'Immediately unhook (we have the handle we're looking for, and don't want to fire any more CBT events)
UnhookWindowsHookEx hHook
'Call EnumChildWindowProc once for each window that is contained in the MsgBox
EnumChildWindows wParam, AddressOf EnumChildWindowProc, 0
'Reinitialize the static buttoncount variable, see the proc
EnumChildWindowProc 0, 1
'Should always be true, but this prevents an abend if for some reason we fail to get the text window
If hwndStatic Then
'If the x parameter has been supplied to the main wrapper, then xPixels <> 0
If xPixels Then
With Screen
'Center the MsgBox window in the screen
SetWindowPos wParam, 0, (.Width / .TwipsPerPixelX - xPixels) / 2, _
(.Height / .TwipsPerPixelY - yPixels) / 2, xPixels, yPixels, 0
End With
'Analogous to the ScaleWidth and ScaleHeight properties. Client rectangle's dimensions are
'returned to the rc type and exclude the dimensions of the title bar and the borders.
GetClientRect wParam, rc
'Calculate x and y values for text window. If there's an icon, we need to reduce the size of the
'text window by the width of the icon plus a standard offset value.
statX = rc.Right - rc.Left - STW_OFFSET * 2 - ((isIcon And 1) * (ICON_WIDTH + STW_OFFSET))
statY = rc.Bottom - rc.Top - BTN_HEIGHT - STW_OFFSET * 2
'We need to position the text window along the x axis such that it's a standard offset from the left
'border of the msgbox, plus the width of the icon and another standard offset if the icon exists.
SetWindowPos hwndStatic, 0, STW_OFFSET + (isIcon And 1) * (ICON_WIDTH + STW_OFFSET), STW_OFFSET, statX, statY, 0
isIcon = 0
'Loop through the button handles, calculating the left border position each time.
For i = 0 To UBound(ButtonHandles)
'Current left border is half the container window's width, less the width of half the total
'number of buttons, plus the offset of the current button in the array.
cLeft = Int(xPixels / 2 + BTN_WIDTH * (i - (UBound(ButtonHandles) + 1) / 2))
'Modify the above to add button spacer widths.
cLeft = cLeft + BTN_SPACER * (i - (UBound(ButtonHandles) - 1) + (UBound(ButtonHandles) Mod 2) / 2)
'The Y value is 1 standard offset more than the height of the text window.
SetWindowPos ButtonHandles(i), 0, cLeft, statY + STW_OFFSET, BTN_WIDTH, BTN_HEIGHT, 0
Next
End If
SendMessage hwndStatic, WM_SETFONT, myFont.hFont, True
End If
End If
CBTProc = 0 ' allow operation to continue
End Function
Private Function EnumChildWindowProc(ByVal hChild As Long, ByVal lParam As Long) As Long
Static ButtonCount As Integer
Dim sLen As Integer
Dim wClass As String
Dim wText As String
Dim rc As RECT
If lParam Then
ButtonCount = 0 'See the direct call of this proc in CBTProc: resets the ButtonCount variable to 0
Exit Function
End If
wClass = String(64, 0)
'look up the type of the current window
sLen = GetClassName(hChild, wClass, 63)
wClass = Left(wClass, sLen)
'We have either one or two static windows: optionally the icon (the first window if it's there) and the
'text window (analogous to a label control).
If wClass = "Static" Then
'If we already have the text window's handle, we don't need to do this anymore.
If Not hwndStatic Then
'Find out if the current window's text value is the same as the text passed in to the cPrompt
'argument in the main wrapper function. If it is, it's the text window and we store the handle
'value in hwndStatic. If it isn't, then it's an icon and we set the isIcon flag.
wText = String(Len(cPrompt) + 1, 0)
sLen = SendMessageS(hChild, WM_GETTEXT, 255, wText)
wText = Left(wText, sLen)
If wText = cPrompt Then
hwndStatic = hChild
Else
isIcon = True
End If
End If
ElseIf wClass = "Button" Then
'Store the button's handle in the ButtonHandles array
ReDim Preserve ButtonHandles(ButtonCount)
ButtonHandles(ButtonCount) = hChild
ButtonCount = ButtonCount + 1
End If
EnumChildWindowProc = 1 ' Continue enumeration
End Function
[/color]
