vb里怎样在窗体外部改变鼠标形状？
发布网友
发布时间：2022-04-22 03:44
共2个回答
热心网友
时间：2022-07-12 21:49
'永远改变系统鼠标指针
Option Explicit
Private Declare Function GetCurrentTime Lib "kernel32" Alias "GetTickCount" () As Long
Private Declare Function GetCursor Lib "user32" () As Long
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 = 321 'The empty icon cursor (Win NT only).
ecNo = 328 'The circle with slash through it cursor.
ecNormal = 32512 'The normal arrow cursor.
ecSize = 320 'The four-arrow resize/move cursor (Win NT only).
ecSizeAll = 326 'The four-arrow resize/move cursor.
ecSizeNESW = 323 'The double-arrow resize/move cursor pointing to the upper-right and lower-left.
ecSizeNS = 325 'The double-arrow resize/move cursor pointing up and down.
ecSizeNWSE = 322 'The double-arrow resize/move cursor pointing to the upper-left and lower-right.
ecSizeWE = 324 '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 :
Private 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)
Else
lhwndNewCursor = GetCursor()
End If
'Set the new system cursor
SystemCursor = CBool(SetSystemCursor(lhwndNewCursor, eSysCursorType)) 'Returns 1 if successful, or 0 if an error occured
End Function
Public Sub Delay(ByVal iiSecond As Integer)
Dim t As Long, t1 As Long, t2 As Long
t1 = GetCurrentTime
t2 = 0
t = iiSecond * 1000
Do Until t2 > t
DoEvents
t2 = GetCurrentTime - t1
Loop
End Sub
Private Sub Command1_Click()
Dim lbRet As Boolean
'鼠标的形状可以指定任意光标文件。在这里我可以不指定，直接用GetCursor--这个函数返回的是当前线程的指针
'不过好像鼠标变了以后不能恢复--不要破坏由hcur指定的指针——在必要的时候，它会由系统自行清除
'自己到E:\WINNT\Cursors下面去找个好点的光标吧
lbRet = SystemCursor(App.Path & "\3dgwe.cur", ecNormal)
Delay 5
lbRet = SystemCursor(App.Path & "\3dwarro.cur", ecNormal)
End Sub
Private Sub Form_Load()
End Sub
热心网友
时间：2022-07-12 21:50
百度调用api改变鼠标形状。追问没找着
