Can you change the cursor for a message box (VB 6)? 1

[missinglinq]

I know how to change the mouse cursor for commands, etc, but can you do the same for the message box cursor (or other things, for that matter, like changing colors for command buttons, etc in a message box)?

Thanks "It's got to be the going,
not the getting there that's good!"
-Harry Chapin

 

[snalwala]

You can use the same for even msgbox...

like..

screen.MousePointer = vbIbeam
msgbox "Here goes the message box"
screen.mousepointer = vbdefault

 

[missinglinq]

Thanks for the try, snalwala, but this doesn't work. When the message box appears the cursor over the form (screen) changes to the Ibeam, but the cursor over the message box stays the default arrow. According to the MSDN this technique only works for forms and dialog boxes.

I appreciate the help anyway, because now I know how to change the cursor for these controls programatically (which I couldn't do before). "It's got to be the going,
not the getting there that's good!"
-Harry Chapin

 

[strongm]

It can be done, but it's a little convoluted (or at least my solution is). Still interested?

 

[missinglinq]

Sure, strongm, fire away! "It's got to be the going,
not the getting there that's good!"
-Harry Chapin

 

[strongm]

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.

 

[strongm]

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

 

[strongm]

Hmm - don't know how that happened. Really must try and learn how computers work...

 

[missinglinq]

Thanks for taking the time to help, strongm!

Linq Adams "It's got to be the going,
not the getting there that's good!"
-Harry Chapin