类型：转载 责任编辑：asp.net 日期：2007/05/23
热门软件下载：
我有一段程序要花费较长的时间,想要把鼠标变成动态沙漏状(Screen.MousePointer = VbHourglass是静态的,结果仍然更死机差不多,效果不好).所以我用下面的方法加载一个动画图标:
Screen.MouseIcon = LoadPicture("busy.ico")
Screen.MousePointer = VbCustom
结果用静态的ico没问题,而一旦用一个动态的gif文件(沙子从上面楼下了,接着又翻转)就会有错误,:无效属性值无效(实时错误380)怎么办才可以??帮忙.文件肯定没有错误.试了几个其他动画文件仍然是一样的问题.
网友回答：
使用动画光标的例子
Option Explicit
>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
API declare
Private Declare Function LoadCursorFromFile Lib "user32" Alias "LoadCursorFromFileA" (ByVal lpFileName As String) As Long
Private Declare Function DestroyCursor Lib "user32" (ByVal hCursor As Long) As Long
Private Declare Function SetClassLong Lib "user32" Alias "SetClassLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Const declare
Private Const GCL_HCURSOR = (-12)
Dim AniCur As Long
>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Private Sub Form_Load()
AniCur& = LoadCursorFromFile(App.Path & "\Neko.ani")
SetClassLong Me.hwnd, GCL_HCURSOR, AniCur
End Sub
Private Sub Form_Unload(Cancel As Integer)
DestroyCursor AniCur
End Sub
应该修改整个应用程序的鼠标，否则就逐个修改窗体上控件的鼠标。
使用系统的忙也兼容了无法载入动态鼠标时的处理方式。
Option Explicit
Private Declare Function CopyCursor Lib "user32" Alias "CopyIcon" (ByVal hcur As Long) As Long
Private Declare Function GetCursor Lib "user32" () As Long
Private Declare Function LoadCursorFromFile Lib "user32" Alias "LoadCursorFromFileA" (ByVal lpFileName As String) As Long
Private Declare Function DestroyCursor Lib "user32" (ByVal hCursor As Long) As Long
Private Declare Function SetSystemCursor Lib "user32" (ByVal hcur As Long, ByVal id As Long) As Long
Private Const OCR_WAIT = 32514
Dim hCursor As Long, hOldCursor As Long
Private Sub Command1_Click()
Me.MousePointer = vbHourglass
需要花费较多事件的代码...
Me.MousePointer = vbNormal
End Sub
Private Sub Form_Load()
Dim lRet As Long
hCursor = LoadCursorFromFile("c:\windows\cursors\appstar.ani")
If hCursor Then
lRet = GetCursor()
hOldCursor = CopyCursor(lRet)
lRet = SetSystemCursor(hCursor, OCR_WAIT)
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim lRet As Long
If hCursor Then
lRet = SetSystemCursor(hOldCursor, OCR_WAIT)
DestroyCursor hCursor
End If
End Sub