by Jonathan Valentin (5 Submissions)
Category: Miscellaneous
Compatability: Visual Basic 5.0
Difficulty: Unknown Difficulty
Originally Published: Sun 18th June 2000
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
CUSOR FUNCTIONS https://www.homestead.com/vbgames6/index.html
API Declarations
Declare Function GlobalLock Lib "Kernel" (ByVal hMem As Integer) As Long
Declare Function GlobalUnLock Lib "Kernel" (ByVal hMem As Integer) As Integer
Declare Function CreateCursor Lib "User" (ByVal hInstance%, ByVal nXhotspot%, ByVal nYhotspot%, ByVal nWidth%, ByVal nHeight%, ByVal lpANDbitPlane As Any, ByVal lpXORbitPlane As Any) As Integer
Declare Function GetWindowWord Lib "User" (ByVal hWnd As Integer, ByVal nIndex As Integer) As Integer
Declare Function SetClassWord Lib "User" (ByVal hWnd As Integer, ByVal nIndex As Integer, ByVal nNewWord As Integer) As Integer
Declare Function GetClassWord Lib "User" (ByVal hWnd As Integer, ByVal nIndex As Integer) As Integer
Declare Function GetBitmapBits Lib "Gdi" (ByVal hBitmap As Integer, ByVal dwCount As Long, ByVal lpbits As String) As Long
Global Const GCW_HCURSOR = -12
Global Const GWW_HINSTANCE = -6
VBcoders
Sub GetHotSpot(CursorPic As Control, xhs As Integer, yhs As Integer)
yhs = 14
xhs = 15
Exit Sub
Dim Ret As Long
Dim lpbits As String * 1024
Dim bits As Integer
'Retrieve the cursor bits to check for the hotspot (x,y)
CursorPic.Visible = True
CursorPic.Refresh
bits = Val(CursorPic.Image)
Ret = GetBitmapBits(bits, 1024, lpbits)
CursorPic.Visible = False
yhs = 0
xhs = 0
'Find the red pixel x,y position for hotspot location
For bits = 1 To 1024
Ret = Asc(Mid$(lpbits, bits, 1))
If (bits \ 32) = 13 Then
bits = bits
End If
If Mid$(lpbits, bits, 1) = "ù" Then
yhs = Int(bits / 32) + 1
xhs = bits - ((yhs - 1) * 32)
End If
Next bits
End Sub
Sub RestoreCursor(hWnd As Integer, OldCursor As Integer)
Dim Ret As Integer
Ret = SetClassWord(hWnd, GCW_HCURSOR, OldCursor)
OldCursor = 0
End Sub
Function SetCursor(hWnd As Integer, CursorPic As Control, CursorPicX As Control) As Integer
Dim ghInstance As Integer
Dim lpand As Long, lpandx As Long
Dim Ret As Integer
Dim hNewCursor As Integer
Dim hotx As Integer
Dim hoty As Integer
'Set the hotspot by retrieving the location of the first
'picture containing the red pixel
Call GetHotSpot(CursorPic, hotx, hoty)
'CursorPic is a picture box control with a 32x32 pixels mono bitmap
'CursorPicX is an inverted picture box control of the first CursorPic
'The First Picture must contain a light red dot for the hotspot position
'(The CursorPicX is created to allow white & background to be defined ok)
'(Refer of the .ico files incloded to see how to do it for other cursors)
'hWnd is the handle of the window or control to apply the new cursor to
'Retreive window or control instance and pictures adresses
SetCursor = GetClassWord(hWnd, GCW_HCURSOR)
ghInstance = GetWindowWord(hWnd, GWW_HINSTANCE)
lpand = GlobalLock(CursorPic.Picture)
lpandx = GlobalLock(CursorPicX.Picture)
'Set the cursor
hNewCursor = CreateCursor(ghInstance, hotx, hoty, 32, 32, lpand + 12, lpandx + 12)
'Free memory
Ret = GlobalUnLock(CursorPic.Picture)
Ret = GlobalUnLock(CursorPicX.Picture)
'Apply the cursor to the window or control defined by hWnd
Ret = SetClassWord(hWnd, GCW_HCURSOR, hNewCursor)
End Function