home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / code / grafik / cursor / cursor.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-02-27  |  4.2 KB  |  119 lines
  1. VERSION 2.00
  2. Begin Form Cursors 
  3.    BackColor       =   &H00C0C0C0&
  4.    Caption         =   "Custom Cursor Sample"
  5.    ClientHeight    =   1950
  6.    ClientLeft      =   3735
  7.    ClientTop       =   3030
  8.    ClientWidth     =   3135
  9.    Height          =   2475
  10.    Left            =   3675
  11.    LinkTopic       =   "Form1"
  12.    ScaleHeight     =   1950
  13.    ScaleWidth      =   3135
  14.    Top             =   2565
  15.    Width           =   3255
  16.    Begin CommandButton Command3 
  17.       Caption         =   "END"
  18.       Height          =   1215
  19.       Left            =   1800
  20.       TabIndex        =   2
  21.       Top             =   360
  22.       Width           =   975
  23.    End
  24.    Begin Timer Timer1 
  25.       Interval        =   1
  26.       Left            =   0
  27.       Top             =   0
  28.    End
  29.    Begin CommandButton Command2 
  30.       Caption         =   "Command2"
  31.       Height          =   735
  32.       Left            =   480
  33.       TabIndex        =   1
  34.       Top             =   840
  35.       Width           =   1215
  36.    End
  37.    Begin CommandButton Command1 
  38.       Caption         =   "Command1"
  39.       Height          =   375
  40.       Left            =   480
  41.       TabIndex        =   0
  42.       Top             =   360
  43.       Width           =   1215
  44.    End
  45. ' This form demonstrates how to have custom cursors
  46. ' over button controls
  47. ' W.Swift
  48. ' 5.1.95
  49. ' ISIS Project
  50. Option Explicit
  51. Declare Sub FreeLibrary Lib "Kernel" (ByVal hLibModule As Integer)
  52. Declare Sub GetCursorPos Lib "User" (p As PointType)
  53. Declare Function SetCursor Lib "User" (ByVal hCursor As Integer) As Integer
  54. Declare Function LoadCursor Lib "User" (ByVal hInstance As Integer, ByVal CusorName As Any) As Integer
  55. Declare Function LoadLibrary Lib "Kernel" (ByVal LibName$) As Integer
  56. Declare Function SetClassWord Lib "User" (ByVal hWnd As Integer, ByVal nIndex As Integer, ByVal NewValas As Integer) As Integer
  57. Declare Function DestroyCursor Lib "User" (ByVal Handle As Integer) As Integer
  58. Declare Function WindowFromPoint Lib "User" (ByVal y As Integer, ByVal x As Integer) As Integer
  59. Const IDC_ARROW = 32512&
  60. Const GCW_HCURSOR = -12
  61. Dim arrowhandle As Integer
  62. Dim DLLInstance As Integer
  63. Dim NewCursorhandle As Integer
  64. Sub Command3_Click ()
  65.     Unload Me
  66. End Sub
  67. Sub Form_Load ()
  68. ' Load the DLL holding cursor resources
  69. ' and get a handle to the system arrow
  70. ' and the new custom cursor
  71. ' Cursors available in cursors.dll are:
  72. ' POINT01    POINT02    POINT03    POINT04    POINT05
  73. ' POINT06    POINT07    POINT08    POINT09    POINT10
  74. ' POINT11    POINT12    POINT13    POINT14    POINT15
  75. ' HANDSHAK   PHONE12    PHONE13    TRASH03    TRASH01
  76. ' TRASH02A   TRASH02B   MAIL03     BINOCULR   HOUSE
  77. ' SECUR08
  78. ' As found in Appendix B of the Programmer's Guide
  79.     Dim lastcursor As Integer
  80.     DLLInstance = LoadLibrary(APP.Path + "\cursors.DLL")
  81.     NewCursorhandle = LoadCursor(DLLInstance, "MAIL03")
  82.     arrowhandle = LoadCursor(0&, IDC_ARROW)
  83. End Sub
  84. Sub Form_Unload (Cancel As Integer)
  85.     Dim success
  86.     Call FreeLibrary(DLLInstance)
  87.     success = DestroyCursor(NewCursorhandle)
  88. End Sub
  89. Sub Timer1_Timer ()
  90. ' Whenever the cursor passes over the required
  91. ' button, set the button's class cursor to null
  92. ' and set the screen cursor to the cutom cursor.
  93. ' When not over the control, if the custom cursor
  94. ' is shown set it back again to an arrow.
  95. ' We set the button cursor blnak to stop windows
  96. ' resetting the cursor when the mouse moves.
  97.     Dim lastcursor As Integer
  98.     Dim p As PointType
  99.     Static fCustom As Integer
  100.     Static FormMousePointer As Integer
  101.     Call GetCursorPos(p)
  102.     Select Case WindowFromPoint(p.y, p.x)
  103.         Case Command1.hWnd
  104.             If Not fCustom Then
  105.                 FormMousePointer = Me.MousePointer
  106.                 Me.MousePointer = False
  107.                 lastcursor = SetClassWord(Command1.hWnd, GCW_HCURSOR, 0&)
  108.                 lastcursor = SetCursor(NewCursorhandle)
  109.                 fCustom = True
  110.             End If
  111.         Case Else
  112.             If fCustom Then
  113.                 Me.MousePointer = FormMousePointer
  114.                 lastcursor = SetCursor(arrowhandle)
  115.                 fCustom = False
  116.             End If
  117.     End Select
  118.     End Sub
  119.