VB and VBA Users Source Code: Permanently alter a system cursor
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Permanently alter a system cursor
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Thursday, February 08, 2001
Hits:
1028
Category:
Windows API
Article:
The following function permanently alters the specified system cursor: Private Declare Function SetSystemCursor Lib "user32.dll" (ByVal hcur As Long, ByVal id As Long) As Long Private Declare Function LoadCursorFromFile Lib "user32" Alias "LoadCursorFromFileA" (ByVal lpFileName As String) As Long Public Enum eCursorType ecAppStarting = 32650 'The application starting (arrow and hourglass) cursor. ecCross = 32515 'The cross-shaped cursor. ecIBeam = 32513 'The text selection (I-beam) cursor. ecIcon = 32641 'The empty icon cursor (Win NT only). ecNo = 32648 'The circle with slash through it cursor. ecNormal = 32512 'The normal arrow cursor. ecSize = 32640 'The four-arrow resize/move cursor (Win NT only). ecSizeAll = 32646 'The four-arrow resize/move cursor. ecSizeNESW = 32643 'The double-arrow resize/move cursor pointing to the upper-right and lower-left. ecSizeNS = 32645 'The double-arrow resize/move cursor pointing up and down. ecSizeNWSE = 32642 'The double-arrow resize/move cursor pointing to the upper-left and lower-right. ecSizeWE = 32644 'The double-arrow resize/move cursor pointing left and right. ecUp = 32516 'The up arrow cursor. ecWait = 32514 'The waiting (hourglass) cursor. End Enum 'Purpose : Permanently changes the specified system cursor 'Inputs : eSysCursorType The system cursor to alter. ' sCursorPath The path of the new cursor to use. 'Outputs : Returns True on success 'Author : Andrew Baker 'Date : 31/01/2001 14:35 'Notes : 'Revisions : Function SystemCursor(sCursorPath As String, eSysCursorType As eCursorType) As Boolean Dim lhwndNewCursor As Long If Len(Dir$(sCursorPath)) > 0 And Len(sCursorPath) > 0 Then 'Load the cursor from file lhwndNewCursor = LoadCursorFromFile(sCursorPath) 'Set the new system cursor SystemCursor = CBool(SetSystemCursor(lhwndNewCursor, eSysCursorType)) 'Returns 1 if successful, or 0 if an error occured End If End Function
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
