MouseIcon on Win7

[Andrzejek]

I used to have machine with Windows XP and all *cur files in C:\Windows\Cursors location.

Now we moved to Windows 7 and I need to assign MouseIcon to a label so it will look and feel like a link (a hand with a finger pointing up, but not 'that’ finger). I have it all done, but I cannot find a *.cur file to use in my VB 6 application on my computer. In the MouseIcon property I can point to C:\Windows\Cursors location and select any *.cur files, but I get a message: “Invalid picture” when I select any of the cur files in VB 6. I guess it is because they all are 64-bit and I need 32-bit? (Is that right?)

How can I change the MouseIcon in VB 6 working in Windows 7?


Have fun.

---- Andy

 

[dilettante]

I really don't think you are meant to go spelunking through OS folders and trying to use random stuff like this that you find there.

There is a documented approach for doing this very thing though, and it seems to be woking fine on Xp SP3, Vista SP2 and Win7 SP1. It doesn't change the mouse pointer under Win95 OSR2 though, even with the Desktop Update. This is as documented as well (Win98 is the minimum version that supports this cursor).

Option Explicit
 
Private Const IDC_HAND As Long = 32649 'Requires Win98 or later.
 
Private Type PictDesc_Icon
    cbSizeofStruct As Long
    picType As Long
    hIcon As Long
End Type
 
Private Type Guid
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type
 
Private Declare Function LoadCursor Lib "user32" Alias "LoadCursorW" ( _
    ByVal hInstance As Long, _
    ByVal lpCursorName As Long) As Long
 
Private Declare Function OleCreatePictureIndirect Lib "olepro32" ( _
    ByVal lpPictDesc As Long, _
    ByVal riid As Long, _
    ByVal fOwn As Long, _
    ByRef lplpvObj As IPicture) As Long
 
Private Function GetHandCursor() As StdPicture
    Dim hHandCursor As Long
    Dim IPictureIID As Guid
    Dim Desc As PictDesc_Icon
    
    hHandCursor = LoadCursor(0, IDC_HAND)
    If hHandCursor <> 0 Then
        With IPictureIID
            .Data1 = &H7BF80980
            .Data2 = &HBF32
            .Data3 = &H101A
            .Data4(0) = &H8B
            .Data4(1) = &HBB
            .Data4(2) = &H0
            .Data4(3) = &HAA
            .Data4(4) = &H0
            .Data4(5) = &H30
            .Data4(6) = &HC
            .Data4(7) = &HAB
        End With
        With Desc
           .cbSizeofStruct = Len(Desc)
           .picType = vbPicTypeIcon
           .hIcon = hHandCursor
        End With
        OleCreatePictureIndirect VarPtr(Desc), _
                                 VarPtr(IPictureIID), _
                                 True, _
                                 GetHandCursor
    End If
End Function
 
Private Sub Form_Load()
    With Label1
        .MousePointer = vbCustom
        Set .MouseIcon = GetHandCursor()
    End With
End Sub

You can "shorten" it a little by using a call to the GUIDFromString function.

 

[dilettante]

BTW:

Replace the alias "LoadCursorW" by "LoadCursorA" if you really want Win98/Me support. It won't impact NT 4.0 or later (remember, Win2K, XP, etc. are NT) and it gets around the need to install the UnicoWS library on Win9x systems.

 

[Andrzejek]

Thank you dilettante for the lengthy code, but I have decided to use my very short approach:

I did find an old cursor file from one of the older machines with XP (harrow.cur), copied it into my computer, and in the MouseIcon property for my label (lblProjDir) in VB 6 I pointed to it. It ends up to be a part of frx for that Form.

And in code I do:

Private Sub lblProjDir_MouseMove(Button As Integer, 
    Shift As Integer, X As Single, Y As Single)

With lblProjDir
    If Len(.Caption) > 0 Then
        .MousePointer = vbCustom
        .ForeColor = vbBlue
        .FontUnderline = True
    End If
End With

End Sub

This label is on a Frame, so I also have this:

Private Sub fraProject_MouseMove(Button As Integer, 
    Shift As Integer, X As Single, Y As Single)

With lblProjDir
    .MousePointer = vbDefault
    .ForeColor = vbBlack
    .FontUnderline = False
End With

End Sub

Have fun.

---- Andy

 

[dilettante]

You can lead a horse to water...

Whatever floats your boat I guess.

 

[Andrzejek]

I really do appreciate your help, and the code that comes along with it, but sometimes ‘easy does it’

Have fun.

---- Andy

 

[strongm]

Heck, if you are happy to use the MouseMove event then you can go with:[tt][blue]

Option Explicit

Private Declare Function LoadCursor Lib "user32" Alias "LoadCursorW" (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long
Private Declare Function SetCursor Lib "user32" (ByVal hCursor As Long) As Long

Private Const IDC_HAND As Long = 32649 'Requires Win98 or later.

Private Sub lblProjDir_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
SetCursor LoadCursor(0&, IDC_HAND)
End Sub[/blue][/tt]

 

[dilettante]

A little processor intensive though. MouseMove events fire at a pretty good clip.