Harte Nuss (API)
08.06.2005 18:45:15
Camel
ich versuche mein Form etwas aufzupeppen und möchte einen aninimierten
Cursor eine bestimmte Zeit anzeigen, also solnage Excel das Sheet mit
4000 Rows füllt oder so...
Ich habe mich schon daran versucht aber leider funktioniert es nicht hat jemand
eine Tipp, hier mein Code (reichlich verworren):
Option Explicit
Private Declare Function SetClassLong Lib "User32" Alias _
"SetClassLongA" (ByVal hwnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) 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 GlobalLock Lib "Kernel32" (ByVal _
hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "Kernel32" (ByVal _
hMem As Long) As Long
Private Declare Function SetCursor Lib "user32.dll" (ByVal hCursor As Long) As Long
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Const GCW_HCURSOR = -12
Dim hCursor As Long
Private hwnd As Long
Dim OldCaption As String
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub Label1_Click()
End Sub
Private Sub ComboBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim FileName As String
FileName = ComboBox1.List(ComboBox1.ListIndex)
If FileName <> "(kein Cursor)" Then
hCursor = _
LoadCursorFromFile("C:\WINNT\Cursors" & "\" & FileName)
Call SetCursor(hCursor)
'Sleep 9000
End If
Label1.Caption = "C:\WINNT\Cursors" & "\" & FileName & " " & X
OldCaption = Me.Caption
End Sub
Private Sub UserForm_Activate()
Me.Caption = mod_Main.GLOBAL_UserFormCaption
hwnd = FindWindow(vbNullString, mod_Main.GLOBAL_UserFormCaption)
Me.Caption = OldCaption
ComboBox1.AddItem "(No Cursor)"
ComboBox1.AddItem "appstart.ani"
ComboBox1.AddItem "globe.ani"
ComboBox1.AddItem "hourglas.ani"
ComboBox1.AddItem "piano.ani"
ComboBox1.AddItem "stopwtch.ani"
ComboBox1.AddItem "metronom.ani"
ComboBox1.AddItem "dinosaur.ani"
ComboBox1.AddItem "banana.ani"
ComboBox1.AddItem "coin.ani"
ComboBox1.AddItem "barber.ani"
ComboBox1.AddItem "hand.ani"
ComboBox1.AddItem "drum.ani"
ComboBox1.ListIndex = 0
End Sub
Private Sub ComboBox1_Change()
Dim Cursor As String
Cursor = ComboBox1.List(ComboBox1.ListIndex)
If Not CBool(InStr(Cursor, "(No Cursor)")) Then
hCursor = _
LoadCursorFromFile("C:\WINNT\Cursors" & "\" & Cursor)
Call SetCursor(hCursor)
'Sleep 9000
End If
Label1.Caption = "C:\WINNT\Cursors" & "\" & Cursor
OldCaption = Me.Caption
End Sub
Private Sub UserForm_QueryUnload(ByVal Cancel As Integer)
MakeDefaultCursor
End Sub
Public Sub MakeDefaultCursor()
Me.MousePointer = fmMousePointerCustom
'GlobalUnlock hCursor
'DestroyCursor hCursor
End Sub
Gruss
Camel