changecursor.bas

常用基本函数库,也许你需要的正在其中！如果不做程序

Attribute VB_Name = "ChangeCursor"
'////////////////////////////////////////////////////////////////////////'
'//***************************ChangeCursor*****************************//'
'//*************************By Drew Burchett***************************//'
'//                                                                    //'
'//   These declarations are all necessary for the subroutines to
'//   use animated cursors with Visual Basic.  The first section
'//   is constants used to identify system cursors to the SetSystemCursor
'//   Function.  The second section contains declares for the functions
'//   necessary to conclude this operation.
'//   Please see the Readme.txt for information on using these functions
'//   with your program.
'//   WARNING!  These functions are only for use with the Win32 operating
'//   system.  They will not work on Windows 3.1 or earlier.
'//
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////'

Const OCR_SIZENESW = 32643 ' The NESW Size Arrow
Const OCR_SIZENS = 32645 ' The NS Size Arrow
Const OCR_SIZENWSE = 32642 ' The NWSE Diagonal Size Arrow
Const OCR_SIZEWE = 32644 ' The WE Size Arrow
Const OCR_UP = 32516 'The Up Arrow
Const OCR_WAIT = 32514 ' The Wait cursor

Private Declare Function GetCursor Lib "user32" () As Long ' Gets the current system cursor
Private Declare Function LoadCursorFromFile Lib "user32" Alias "LoadCursorFromFileA" (ByVal lpFileName As String) As Long
' Loads a handle to a cursor from a valid cursor file
Private Declare Function CopyIcon Lib "user32" (ByVal hIcon As Long) As Long
' Makes a copy of a non-animated icon or cursor and returns a handle to the copy
Private Declare Function SetSystemCursor Lib "user32" (ByVal hcur As Long, ByVal id As Long) As Long
' Sets the current system cursor
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
' Deletes the system handle to a custom created object.

Dim HoldCursor As Long ' This will hold the system cursor until used to change back
Dim Cursor As Long, Cursor2 As Long ' The variables used to hold_
'your cursors

'/////////////////////////////////////////////////////////////////////////'
'// This routine is used to change to an animated cursor.               //'
'/////////////////////////////////////////////////////////////////////////'

Public Function AnimateCursor(Frm As Form, fName As String) As Long

Cursor = LoadCursorFromFile(fName) ' Loads a cursor from the file_
'specified by fName

Frm.MousePointer = 5 ' Change the mouse pointer of the form passed_
'by Frm.  Do not change this value without changing the corresponding_
'constant in the SetSystemCursor function.

Cursor2 = GetCursor ' Gets the handle to the current system cursor

HoldCursor = CopyIcon(Cursor2) ' Creates the copy of the current cursor_
'for restoration later.

AnimateCursor = SetSystemCursor(Cursor, OCR_SIZENESW) ' Change the current_
'cursor to the choosen animated cursor and returns a value indicating success_
'or failure.

End Function


'///////////////////////////////////////////////////////////////'
'// The subroutine to change your cursor back.                //'
'///////////////////////////////////////////////////////////////'

Public Function RestoreCursor(Frm As Form) As Long

RestoreCursor = SetSystemCursor(HoldCursor, OCR_SIZENESW) ' Restore the cursor_
'to the previous copy.

Frm.MousePointer = 0 ' Return the form mouse pointer to default

DeleteObject Cursor
DeleteObject Cursor2
DeleteObject HoldCursor
' Be sure to clean up after yourself and get rid of any unused cursor handles

End Function