请问用什么函数或方法可以使自定义的系统鼠标方案立即生效？

lclean 2005-10-28 10:45:58

我先将鼠标路径逐一添如注册标，然后在form1中添加一个按钮，点击按钮使鼠标方案立即生效，请问用什么函数或方法？谢谢！

...全文

246 7 打赏收藏转发到动态举报

写回复

用AI写文章

7 条回复

切换为时间正序

请发表友善的回复…

发表回复

northwolves 2005-10-31

打赏
举报

'2 API:
'ADD A BLANK FORM AND PASTE THE FOLLOWING CODES TO IT ,THEN LEFT MOUSE DOWN OR RIGHT MOUSE DOWN

Option Explicit

Private Declare Function LoadCursorFromFile Lib "user32" Alias "LoadCursorFromFileA" (ByVal lpFileName As String) As Long
Private Declare Function SetSystemCursor Lib "user32" (ByVal hcur As Long, ByVal id As Long) As Long
Private Const OCR_NORMAL = 32512

Dim newcursor As Long
Dim cursors As New Collection

Sub loadcursors() ' load cursors from system
Dim mydir As String, fname As String

mydir = Environ("windir") & "\cursors\"
fname = Dir(mydir)
Do While fname <> ""
cursors.Add mydir & fname
fname = Dir
Loop
End Sub

Sub loaddefaultcursor()
Dim defaultcursor As Long ' set default system cursor
defaultcursor = LoadCursorFromFile(Environ("windir") & "\cursors\arrow_l.cur")
SetSystemCursor defaultcursor, OCR_NORMAL
End Sub
Sub loadnewcursor() ' set a new system cursor
Dim cursorfile As String
Randomize
cursorfile = cursors(Int(Rnd * cursors.Count + 1)) 'random cursor file
newcursor = LoadCursorFromFile(cursorfile)
SetSystemCursor newcursor, OCR_NORMAL
Me.Caption = cursorfile
End Sub
Private Sub Form_Load()
loadcursors
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then loadnewcursor
If Button = 2 Then loaddefaultcursor
End Sub

Private Sub Form_Unload(Cancel As Integer) ' default system cursor
loaddefaultcursor
End Sub

lclean 2005-10-30