Ok, here you go. Drop the following code into a module. Use it by calling vbMsgBox rather than the normal MsgBox function. The new function has an extra optional parameter, which is the cursor that you want to use:
[tt]
Option Explicit
' Enumeration of the cursor types
' Can't use the VB declared versions in our API calls
Public Enum CursorTypes
IDC_APPSTARTING = 32650&
IDC_ARROW = 32512&
IDC_CROSS = 32515&
IDC_IBEAM = 32513&
IDC_ICON = 32641&
IDC_NO = 32648&
IDC_SIZE = 32640&
IDC_SIZEALL = 32646&
IDC_SIZENESW = 32643&
IDC_SIZENS = 32645&
IDC_SIZENWSE = 32642&
IDC_SIZEWE = 32644&
IDC_UPARROW = 32516&
IDC_WAIT = 32514&
End Enum
' Necessary constants for hooking, and changinf cursor
Private Const HCBT_ACTIVATE = 5
Private Const HCBT_DESTROYWND = 4
Private Const GWL_HINSTANCE = (-6)
Private Const WH_CBT = 5
Private Const GCL_HCURSOR = (-12)
' Working variables that require global scope in hooking module
Private mCursorType As CursorTypes
Private hHook As Long
' The API declarations we need
Public Declare Function GetClassLong Lib "user32" Alias "GetClassLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetClassLong Lib "user32" Alias "SetClassLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName 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 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 UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
' Our wrapper for the normal MsgBox function takes an additional optional
' parameter that defines the cursor to be used
Public Function vbMsgBox(Prompt As String, Optional Buttons As VbMsgBoxStyle = vbOKOnly, Optional Title As String, Optional HelpFile As String, Optional Context As Long, Optional CursorType As CursorTypes = 0) As Long
hHook = SetWindowsHookEx(WH_CBT, AddressOf WinProc, App.hInstance, 0) 'Thread)
mCursorType = CursorType ' Make note of required cursor type
vbMsgBox = MsgBox(Prompt, Buttons, Title, HelpFile, Context)
End Function
Private Function WinProc(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Static hMessageBox As Long
Static OldClassCursor As Long
If lMsg = HCBT_ACTIVATE Then
If hMessageBox = 0 Then hMessageBox = wParam ' Save MsgBox hWnd
If hMessageBox = wParam Then
OldClassCursor = GetClassLong(wParam, GCL_HCURSOR) ' Remember original class cursor
SetClassLong wParam, GCL_HCURSOR, LoadCursor(0&, mCursorType)
End If
End If
If lMsg = HCBT_DESTROYWND Then
If hMessageBox = wParam Then ' Are we destroying the MsgBox?
SetClassLong wParam, GCL_HCURSOR, OldClassCursor ' Restore original class cursor before we destroy
hMessageBox = 0 ' Clear saved handle
UnhookWindowsHookEx hHook ' Finally unhook...
End If
End If
WinProc = False
End Function
[/tt]
if you have a form with a command button on it you can drop in the following as a test of the function:
[tt]
Private Sub Command1_Click()
vbMsgBox "Just testing", , , , , IDC_SIZECROSS
End Sub
[/tt]
Note that this particular technique gains you the hWnd of the MsgBox during the HCBT_ACTIVATE event, so you can use it for other tricks that are normally not possible, such as placing the MsgBox wherever you like rather than letting Windows place it for you...
A word of warning: don't try and debug whilst the hook is in place, as the VB IDE will crash.
