home *** CD-ROM | disk | FTP | other *** search
/ The Final Windows Shareware CD / _.img / winshare / vb / custcrs / cursor.bas < prev    next >
BASIC Source File  |  1993-09-05  |  2KB  |  57 lines
  1. Const PIXELS = 3
  2. Const RED = &HFF&
  3. Const GCW_HCURSOR = -12
  4. Const GWW_HINSTANCE = -6
  5. Const BITS_OFFSET = 12
  6.  
  7. Type CursorInfo
  8.      hWnd       As Integer
  9.      hOldCursor As Integer
  10.      hNewCursor As Integer
  11. End Type
  12.  
  13. Declare Function GlobalLock Lib "Kernel" (ByVal hMem%) As Long
  14. Declare Function GlobalUnLock Lib "Kernel" (ByVal hMem%) As Integer
  15. Declare Function CreateCursor Lib "User" (ByVal hinst%, ByVal xHotSpot%, ByVal yHotSpot%, ByVal nWidth%, ByVal nHeight%, ByVal lpvANDPlane As Any, ByVal lpvXORPlane As Any) As Integer
  16. Declare Function DestroyCursor Lib "User" (ByVal hcur%) As Integer
  17. Declare Function GetWindowWord Lib "User" (ByVal hWnd%, ByVal nIndex%) As Integer
  18. Declare Function SetClassWord Lib "User" (ByVal hWnd%, ByVal nIndex%, ByVal wNewWord%) As Integer
  19. Declare Function GetPixel Lib "GDI" (ByVal hDC%, ByVal nXPos%, ByVal nYPos%) As Long
  20.  
  21. Function ChangeCursor (ByVal hWnd As Integer, hCursor As Integer)
  22.     ChangeCursor = SetClassWord(hWnd, GCW_HCURSOR, hCursor)
  23. End Function
  24.  
  25. Sub FindHotSpot (CursorPic As Control, x As Integer, y As Integer)
  26.     
  27.     For x = 0 To (CursorPic.ScaleWidth - 1)
  28.     For y = 0 To (CursorPic.ScaleHeight - 1)
  29.         If GetPixel(CursorPic.hDC, x, y) = RED Then Exit Sub
  30.     Next y
  31.     Next x
  32.  
  33.     x = 0: y = 0
  34. End Sub
  35.  
  36. Sub MakeCursor (ByVal hWnd As Integer, picCursor As Control, picMask As Control, ciCursor As CursorInfo)
  37. Dim x As Integer, y As Integer
  38.  
  39.     picCursor.AutoRedraw = True
  40.     picCursor.ScaleMode = PIXELS
  41.     
  42.     FindHotSpot picCursor, x, y
  43.     
  44.     ciCursor.hWnd = hWnd
  45.     ciCursor.hNewCursor = CreateCursor(GetWindowWord(hWnd, GWW_HINSTANCE), x, y, picCursor.ScaleWidth, picCursor.ScaleHeight, GlobalLock(picCursor.Picture) + BITS_OFFSET, GlobalLock(picMask.Picture) + BITS_OFFSET)
  46.     ciCursor.hOldCursor = ChangeCursor(hWnd, ciCursor.hNewCursor)
  47.     
  48.     z% = GlobalUnLock(picCursor.Picture)
  49.     z% = GlobalUnLock(picMask.Picture)
  50. End Sub
  51.  
  52. Sub RestoreCursor (ciCursor As CursorInfo)
  53.     z% = ChangeCursor(ciCursor.hWnd, ciCursor.hOldCursor)
  54.     z% = DestroyCursor(ciCursor.hNewCursor)
  55. End Sub
  56.  
  57.