Подвижные курсоры
Visual Basic 6.0
Здравствуйте!
Для вставки курсора я знаю два способа:
Первый, собственно:
И второй:
Но первый не может вставлять подвижные курсоры, да и неподвижные не все вставляет, а второй способ вставляет не курсор, а его изображение. Поэтому он всё равно будет неподвижным.
Можект ли кто подсказать, как вставить подвижный курсор?
Спасибо!
Здравствуйте!
Для вставки курсора я знаю два способа:
Первый, собственно:
Код:
Me.MouseIcon = LoadPicture("C:\Windows\metronom.ani")
И второй:
Код:
Option Explicit
Private Declare Function LoadImage Lib "user32.dll" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As Long, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Private Declare Function OleCreatePictureIndirect Lib "oleaut32" (ByRef lpPictDesc As PicBmp, riid As GUID, ByVal fOwn As Long, ByRef lplpvObj As Any) As Long
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Private Type PicBmp
Size As Long
Type As PictureTypeConstants
hBmp As Long
hPal As Long
Reserved As Long
End Type
Private Const IMAGE_CURSOR As Long = 2
Private Const OCR_HAND As Long = 32649
Private Const LR_DEFAULTSIZE As Long = &H40
Private Const LR_SHARED As Long = &H8000
Private Sub Form_Load()
Set Me.MouseIcon = GetPictureFromHandle(LoadImage(0, OCR_HAND, _
IMAGE_CURSOR, 0, 0, LR_DEFAULTSIZE Or LR_SHARED), vbPicTypeIcon)
End Sub
Public Function GetPictureFromHandle(ByVal Handle As Long, ByVal PictureType As PictureTypeConstants) As IPictureDisp
Dim p As PicBmp, g As GUID
With p
.hBmp = Handle
.Size = Len(p)
.Type = PictureType
End With
With g
.Data1 = &H20400
.Data4(0) = &HC0
.Data4(7) = &H46
End With
OleCreatePictureIndirect p, g, 0, GetPictureFromHandle
End Function
Private Declare Function LoadImage Lib "user32.dll" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As Long, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Private Declare Function OleCreatePictureIndirect Lib "oleaut32" (ByRef lpPictDesc As PicBmp, riid As GUID, ByVal fOwn As Long, ByRef lplpvObj As Any) As Long
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Private Type PicBmp
Size As Long
Type As PictureTypeConstants
hBmp As Long
hPal As Long
Reserved As Long
End Type
Private Const IMAGE_CURSOR As Long = 2
Private Const OCR_HAND As Long = 32649
Private Const LR_DEFAULTSIZE As Long = &H40
Private Const LR_SHARED As Long = &H8000
Private Sub Form_Load()
Set Me.MouseIcon = GetPictureFromHandle(LoadImage(0, OCR_HAND, _
IMAGE_CURSOR, 0, 0, LR_DEFAULTSIZE Or LR_SHARED), vbPicTypeIcon)
End Sub
Public Function GetPictureFromHandle(ByVal Handle As Long, ByVal PictureType As PictureTypeConstants) As IPictureDisp
Dim p As PicBmp, g As GUID
With p
.hBmp = Handle
.Size = Len(p)
.Type = PictureType
End With
With g
.Data1 = &H20400
.Data4(0) = &HC0
.Data4(7) = &H46
End With
OleCreatePictureIndirect p, g, 0, GetPictureFromHandle
End Function
Но первый не может вставлять подвижные курсоры, да и неподвижные не все вставляет, а второй способ вставляет не курсор, а его изображение. Поэтому он всё равно будет неподвижным.
Можект ли кто подсказать, как вставить подвижный курсор?
Спасибо!
Код:
Private Declare Function LoadCursorFromFile _
Lib "user32.dll" Alias "LoadCursorFromFileA" ( _
ByVal lpFileName As String) As Long
Private Declare Function SetClassWord _
Lib "user32.dll" ( _
ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal wNewWord As Long) As Long
Private Sub Form_Load()
Dim ihCursor As Long
ihCursor = LoadCursorFromFile("C:\WINDOWS\CURSORS\GLOBE.ANI")
'Указанный файл, естественно, должен наличествовать
SetClassWord Me.hWnd, -12&, ihCursor
End Sub
Lib "user32.dll" Alias "LoadCursorFromFileA" ( _
ByVal lpFileName As String) As Long
Private Declare Function SetClassWord _
Lib "user32.dll" ( _
ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal wNewWord As Long) As Long
Private Sub Form_Load()
Dim ihCursor As Long
ihCursor = LoadCursorFromFile("C:\WINDOWS\CURSORS\GLOBE.ANI")
'Указанный файл, естественно, должен наличествовать
SetClassWord Me.hWnd, -12&, ihCursor
End Sub
Цитата: pashulka
Код:
Private Declare Function LoadCursorFromFile _
Lib "user32.dll" Alias "LoadCursorFromFileA" ( _
ByVal lpFileName As String) As Long
Private Declare Function SetClassWord _
Lib "user32.dll" ( _
ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal wNewWord As Long) As Long
Private Sub Form_Load()
Dim ihCursor As Long
ihCursor = LoadCursorFromFile("C:\WINDOWS\CURSORS\GLOBE.ANI")
'Указанный файл, естественно, должен наличествовать
SetClassWord Me.hWnd, -12&, ihCursor
End Sub
Lib "user32.dll" Alias "LoadCursorFromFileA" ( _
ByVal lpFileName As String) As Long
Private Declare Function SetClassWord _
Lib "user32.dll" ( _
ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal wNewWord As Long) As Long
Private Sub Form_Load()
Dim ihCursor As Long
ihCursor = LoadCursorFromFile("C:\WINDOWS\CURSORS\GLOBE.ANI")
'Указанный файл, естественно, должен наличествовать
SetClassWord Me.hWnd, -12&, ihCursor
End Sub
Спасибо большое. Правда Вы немного ошиблись... Не SetClassWord, а SetClassLong.
Но вот возникает новая проблема. Когда таким образом устанавливаешь курсор, он устанавливается не только на указанный контрол, а на все ТАКИЕ же контролы. Т.е. если я ставлю курсор на один из Label-ов, то он на всех Label-ах такой становится, ну а это, конечно, не приемлемо. Как от этого избавиться?
Использование функции SetClassWord вполне допустимо и стало быть не является ошибочным.
Обращаю внимание на то, что в Вашем первоначальном вопросе/примере - речь шла о создании анимационного курсора для всей формы, а не отдельных контролов, тем более Label, которые вообще не имеют hWnd.
Тем не менее, создать подобный курсор можно и для одной надписи, для этого достаточно :
- расположить на форме Frame, убрать заголовок, при необходимости установить значение свойства BorderStyle как 0 - None, затем бросить на Frame нужный Label и заменить Me.hWnd на Me.Frame1.hWnd
- или обратить свой взор в сторону функции SetCursor
P.S. При ответе цитировать предыдущее сообщение - не нужно.
Обращаю внимание на то, что в Вашем первоначальном вопросе/примере - речь шла о создании анимационного курсора для всей формы, а не отдельных контролов, тем более Label, которые вообще не имеют hWnd.
Тем не менее, создать подобный курсор можно и для одной надписи, для этого достаточно :
- расположить на форме Frame, убрать заголовок, при необходимости установить значение свойства BorderStyle как 0 - None, затем бросить на Frame нужный Label и заменить Me.hWnd на Me.Frame1.hWnd
- или обратить свой взор в сторону функции SetCursor
Код:
Private Declare Function SetCursor Lib "user32.dll" (ByVal hCursor As Long) As Long
P.S. При ответе цитировать предыдущее сообщение - не нужно.
Спасибо, буду пробовать.
Шла речь о форме, но не о всех же формах) А если делать так как Вы предложили, то при наличие второй формы, курсор устанавливается и ей. Поэтому всё равно этот метод не приемлем) Ну по крайней мере так происходит у меня...
А про SetClassWord я сказал, потому что у меня он ничего не делал, курсор не изменялся. Происходило другое - курсор имел такой вид, какой он имел до достижения формы. Например, вид двух стрелок, когда пересекал край формы, или курсор как над тектовым полем, если с любого текстового поля его резко на форму перенести. Уже не знаю почему)
Шла речь о форме, но не о всех же формах) А если делать так как Вы предложили, то при наличие второй формы, курсор устанавливается и ей. Поэтому всё равно этот метод не приемлем) Ну по крайней мере так происходит у меня...
А про SetClassWord я сказал, потому что у меня он ничего не делал, курсор не изменялся. Происходило другое - курсор имел такой вид, какой он имел до достижения формы. Например, вид двух стрелок, когда пересекал край формы, или курсор как над тектовым полем, если с любого текстового поля его резко на форму перенести. Уже не знаю почему)
Имено SetCursor и поможет задать курсор для любого контрола. Только вызывать ее нужно в обработчике события MouseMove:
еще и не плохо бы перехватить MouseDown:
Код:
Option Explicit
Private Declare Function SetCursor Lib "user32.dll" (ByVal hCursor As Long) As Long
Private Declare Function LoadCursorFromFile _
Lib "user32.dll" Alias "LoadCursorFromFileA" ( _
ByVal lpFileName As String) As Long
Private ihCursor As Long
Private Sub Form_Load()
ihCursor = LoadCursorFromFile("C:\WINDOWS\CURSORS\DRUM.ANI")
End Sub
Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
SetCursor ihCursor
End Sub
Private Declare Function SetCursor Lib "user32.dll" (ByVal hCursor As Long) As Long
Private Declare Function LoadCursorFromFile _
Lib "user32.dll" Alias "LoadCursorFromFileA" ( _
ByVal lpFileName As String) As Long
Private ihCursor As Long
Private Sub Form_Load()
ihCursor = LoadCursorFromFile("C:\WINDOWS\CURSORS\DRUM.ANI")
End Sub
Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
SetCursor ihCursor
End Sub
еще и не плохо бы перехватить MouseDown:
Код:
Private Sub Label1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
SetCursor ihCursor
End Sub
SetCursor ihCursor
End Sub
О. Олично) Спасибо большое!
Жаль только, что когда в настройках мыши не стоит никакая схема курсоров, то в реестре к руке никакой путь не прописан и всё равно приходится при этом условии применять другую функцию, написанную мной в первом сообщении...
Жаль только, что когда в настройках мыши не стоит никакая схема курсоров, то в реестре к руке никакой путь не прописан и всё равно приходится при этом условии применять другую функцию, написанную мной в первом сообщении...
Это про какую функцию? там где LoadImage? Ну и здесь ее можно прекрасно использовать:
Код:
Private Sub Form_Load()
ihCursor = LoadImage(0, OCR_HAND, IMAGE_CURSOR, 0, 0, LR_DEFAULTSIZE Or LR_SHARED)
End Sub
ihCursor = LoadImage(0, OCR_HAND, IMAGE_CURSOR, 0, 0, LR_DEFAULTSIZE Or LR_SHARED)
End Sub
О! Ну это вообще то что нужно было с самого начала)
Всем спасибо за помощь!
Стал ещё на 0,1% больше знать в VB)
Всем спасибо за помощь!
Стал ещё на 0,1% больше знать в VB)
Блин!! И всё-таки опять не совершенно получается. Ведь пока двигаешь мышь курсор каждый раз перегружается, на неподвижном курсоре то незаметно, а на анимированном - дёрганье. Если не двигать, то тогда нормально. Опять проблема)
Пробовал отслеживать при движении - предыдущее положение курсора было на этом контроле или нет, если на этом, то не прогружать (потому что вроде как уже прогружался курсор), работает, только курсор то автоматически ставится стандартный...... Чо делать то ёпрст с этим курсором?
Другой язык изучать не буду, сразу говорю)
Пробовал отслеживать при движении - предыдущее положение курсора было на этом контроле или нет, если на этом, то не прогружать (потому что вроде как уже прогружался курсор), работает, только курсор то автоматически ставится стандартный...... Чо делать то ёпрст с этим курсором?
Другой язык изучать не буду, сразу говорю)
Действительно, если в классе окна курсор не NULL, то курсор, установленый с помощью SetCursor, после каждого движения мыши будет восстанавливаться на курсор по умолчанию(т.е. на определенный в классе), поэтому то и надо вызывать SetCursor каждый раз при движении мыши(в обработчик MouseMove). А чтобы он не восстанавливался, ничего другого не остается как только перехватывать сообщение WM_SETCURSOR. Не очень сложно, но действовать надо аккуратно.
Небольшой пример(нужно доработать!!!)
вот собственно модуль формы:
а вот код стандартного модуля:
чтобы перенести логику работы с курсором в модуль формы, в Hook передаю ссылку на саму форму, а к форме добавил метод OnSetCursor.
этот метод вызывается по приходу события WM_SETCURSOR. Если OnSetCursor возвращает 0, то все будет как обычно, курсор будет восстановлен на стандартный курсор окна. если же в OnSetCursor вернуть HANDLE(значение отличное от 0), то будет установлен курсор с этим HANDLE, а стандартный курсор восстанавливаться не будет.
т.к. нет событий MouseOver/MouseOut - использовал то, что сообщение WM_SETCURSOR приходит ПОСЛЕ события MouseMove.
Если мышка двигается над Label1, в MouseMove выставляю CursorSet в True, теперь сразу вызовется OnSetCursor. Здесь, если CursorSet=True(т.е. сразу перед эти событием было Label1_MouseMove) то возвращаем наш новый курсор и CursorSet ставим в False. Соответственно если при в ходе в OnSetCursor , CursorSet = False - значит мышка не над Label1 и нужен стандартный курсор - возвращаем 0.
Конечно, можно это все реализовать как-то по другому, как удобнее. Можно, например, в OnSetCursor передавать координаты мыши, и исходя из них решать какой курсор нам нужен.
Можно еще проверять high-order word of lParam для WM_SETCURSOR, равено 0 если окно в menu-mode.
Небольшой пример(нужно доработать!!!)
вот собственно модуль формы:
Код:
Option Explicit
Private ihCursor As Long
Private CursorSet As Boolean
Private Sub Form_Load()
ihCursor = LoadCursorFromFile("C:\WINDOWS\CURSORS\DRUM.ANI")
Hook Me
End Sub
Private Sub Form_Unload(Cancel As Integer)
Unhook
End Sub
Public Function OnSetCursor() As Long
If CursorSet Then OnSetCursor = ihCursor
CursorSet = False
End Function
Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
CursorSet = True
End Sub
Private ihCursor As Long
Private CursorSet As Boolean
Private Sub Form_Load()
ihCursor = LoadCursorFromFile("C:\WINDOWS\CURSORS\DRUM.ANI")
Hook Me
End Sub
Private Sub Form_Unload(Cancel As Integer)
Unhook
End Sub
Public Function OnSetCursor() As Long
If CursorSet Then OnSetCursor = ihCursor
CursorSet = False
End Function
Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
CursorSet = True
End Sub
а вот код стандартного модуля:
Код:
Option Explicit
Declare Function SetCursor Lib "user32.dll" (ByVal hCursor As Long) As Long
Declare Function LoadCursorFromFile _
Lib "user32.dll" Alias "LoadCursorFromFileA" ( _
ByVal lpFileName As String) As Long
Private Declare Function CallWindowProc Lib "user32" Alias _
"CallWindowProcA" (ByVal lpPrevWndFunc As Long, _
ByVal hwnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hwnd As Long, _
ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const WM_SETCURSOR = &H20
Private Const GWL_WNDPROC = -4
Private IsHooked As Boolean
Private lpPrevWndProc As Long
Private gHW As Long
Private fInst As Form1
Public Sub Hook(Frm As Form1)
If IsHooked Then Exit Sub
gHW = Frm.hwnd
Set fInst = Frm
lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, _
AddressOf WindowProc)
IsHooked = True
End Sub
Public Sub Unhook()
Call SetWindowLong(gHW, GWL_WNDPROC, lpPrevWndProc)
IsHooked = False
gHW = 0
End Sub
Function WindowProc(ByVal hw As Long, ByVal uMsg As _
Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim c As Long
If uMsg = WM_SETCURSOR Then
c = fInst.OnSetCursor
If c <> 0 Then
WindowProc = 1
SetCursor c
Exit Function
End If
End If
WindowProc = CallWindowProc(lpPrevWndProc, hw, _
uMsg, wParam, lParam)
End Function
Declare Function SetCursor Lib "user32.dll" (ByVal hCursor As Long) As Long
Declare Function LoadCursorFromFile _
Lib "user32.dll" Alias "LoadCursorFromFileA" ( _
ByVal lpFileName As String) As Long
Private Declare Function CallWindowProc Lib "user32" Alias _
"CallWindowProcA" (ByVal lpPrevWndFunc As Long, _
ByVal hwnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hwnd As Long, _
ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const WM_SETCURSOR = &H20
Private Const GWL_WNDPROC = -4
Private IsHooked As Boolean
Private lpPrevWndProc As Long
Private gHW As Long
Private fInst As Form1
Public Sub Hook(Frm As Form1)
If IsHooked Then Exit Sub
gHW = Frm.hwnd
Set fInst = Frm
lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, _
AddressOf WindowProc)
IsHooked = True
End Sub
Public Sub Unhook()
Call SetWindowLong(gHW, GWL_WNDPROC, lpPrevWndProc)
IsHooked = False
gHW = 0
End Sub
Function WindowProc(ByVal hw As Long, ByVal uMsg As _
Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim c As Long
If uMsg = WM_SETCURSOR Then
c = fInst.OnSetCursor
If c <> 0 Then
WindowProc = 1
SetCursor c
Exit Function
End If
End If
WindowProc = CallWindowProc(lpPrevWndProc, hw, _
uMsg, wParam, lParam)
End Function
чтобы перенести логику работы с курсором в модуль формы, в Hook передаю ссылку на саму форму, а к форме добавил метод OnSetCursor.
этот метод вызывается по приходу события WM_SETCURSOR. Если OnSetCursor возвращает 0, то все будет как обычно, курсор будет восстановлен на стандартный курсор окна. если же в OnSetCursor вернуть HANDLE(значение отличное от 0), то будет установлен курсор с этим HANDLE, а стандартный курсор восстанавливаться не будет.
т.к. нет событий MouseOver/MouseOut - использовал то, что сообщение WM_SETCURSOR приходит ПОСЛЕ события MouseMove.
Если мышка двигается над Label1, в MouseMove выставляю CursorSet в True, теперь сразу вызовется OnSetCursor. Здесь, если CursorSet=True(т.е. сразу перед эти событием было Label1_MouseMove) то возвращаем наш новый курсор и CursorSet ставим в False. Соответственно если при в ходе в OnSetCursor , CursorSet = False - значит мышка не над Label1 и нужен стандартный курсор - возвращаем 0.
Конечно, можно это все реализовать как-то по другому, как удобнее. Можно, например, в OnSetCursor передавать координаты мыши, и исходя из них решать какой курсор нам нужен.
Можно еще проверять high-order word of lParam для WM_SETCURSOR, равено 0 если окно в menu-mode.
Спасибо за труды) Буду сидеть разбираться, а то прямо из принципа захотелось добиться нормального результата.