• Home
 · 
• Miscellaneous
 · 
• CUSOR FUNCTIONS http://www.homestead.com/vbgames6/index.html

CUSOR FUNCTIONS http://www.homestead.com/vbgames6/index.html

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



Rate CUSOR FUNCTIONS http://www.homestead.com/vbgames6/index.html

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

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