| Вопрос: VB6: как получить перемещения мышки, а не курсора? | Добавлено: 12.10.04 12:05 |
Автор вопроса:  xTractor
|
|
Требуется реализовать элемент "бесконечная линейка", кликнув на который пользователь сможет перемещать ее мышкой хоть до бесконечности, однако в стандартных условиях курсор мыши ограничен рамками экрана.
В связи с этим вопрос: как в VB6 получать не значения перемещения курсора на экране, а собствено перемещения самой мышки? Или может есть способ снять ограничения на перемещения курсора только в рамках экрана? Может что-то еще посоветуете? (Пробовал использовать API-функцию SetCursorPos для установки курсора в центр экрана при достижении зоны вблизи края экрана, но результат не очень понравился: при таком способе "теряется" часть перемещения мышки при быстром движении.) |
| Ответы | Всего ответов: 11 |
|
Номер ответа: 1 Автор ответа:  User Unknown Вечный Юзер! ICQ: uu@jabber.cz Вопросов: 120 Ответов: 3302 |
Профиль | | #1 | Добавлено: 12.10.04 12:09 |
| http://www.tmt.com/helphtml/setmousepos_proc.htm | ||
|
Номер ответа: 2 Автор ответа: xTractor Вопросов: 3 Ответов: 11 |
Профиль | | #2 | Добавлено: 12.10.04 13:41 |
|
to User Unknown:
Извините, а вы собственно содержание вопроса читали? Вы дали ссылку на аналог Windows API-функции SetCursorPos, только для DOS-а, ну и что? |
||
|
Номер ответа: 3 Автор ответа: User UnknownВечный Юзер! ICQ: uu@jabber.cz Вопросов: 120 Ответов: 3302 |
Профиль | | #3 | Добавлено: 12.10.04 13:44 |
А, ну да Сорри Ремарку не заметил...
|
||
|
Номер ответа: 4 Автор ответа:  LamerOnLineICQ: 334781088 Вопросов: 108 Ответов: 2822 |
Профиль | | #4 | Добавлено: 12.10.04 14:35 |
| Используй DirectInput. Дешево и сердито | ||
|
Номер ответа: 5 Автор ответа: xTractorВопросов: 3 Ответов: 11 |
Профиль | | #5 | Добавлено: 12.10.04 15:15 |
|
to LamerOnLine:
можно подробнее, это возможности из комплекта DirectX? Где рекомендуете почитать про связку VB6+DirectInput? |
||
|
Номер ответа: 6 Автор ответа: LamerOnLineICQ: 334781088 Вопросов: 108 Ответов: 2822 |
Профиль | | #6 | Добавлено: 12.10.04 15:18 |
|
Вообще еще можно через SetCursorPos, конечно, запомнив первоначальное положение и при каждом движении его востанавливая (не забыв, разумеется, ClientToScreen преобразование, не то мышь запрыгает). Можно убирать курсор через ShowCursor.
Но, думается, это не самый лучший подход. Не забывай, пользователь тоже ограничен размером стола и длиной шнура мыши. Придумай способ поудобнее. |
||
|
Номер ответа: 7 Автор ответа: LamerOnLineICQ: 334781088 Вопросов: 108 Ответов: 2822 |
Профиль | | #7 | Добавлено: 12.10.04 15:33 |
|
Подключаешь через References библиотеку DirectX 8 for Visual Basic type library. Затем
Option Explicit Dim DX As New DirectX8 Dim DI As DirectInput8 Dim diDev As DirectInputDevice8 Const BufferSize = 50 'ðàçìåð áóôåðà 'ìàññèâ, êîòîðûé áóäåò çàïîëíÿòñÿ 'äàííûìè èç áóôåðà Dim diDeviceData(1 To BufferSize) As DIDEVICEOBJECTDATA Public Function InitDI() As Boolean On Error Resume Next Set DI = DX.DirectInputCreate If DI Is Nothing Then Exit Function Set diDev = DI.CreateDevice("guid_SysMouse" 
If diDev Is Nothing Then Exit Function diDev.SetCommonDataFormat DIFORMAT_MOUSE diDev.SetCooperativeLevel Me.hWnd, DISCL_BACKGROUND Or DISCL_NONEXCLUSIVE 'âñïîìîãàòåëüíàÿ ñòðóêòóðà äëÿ çàäàíèÿ 'ðàçìåðà áóôåðà Dim diProp As DIPROPLONG diProp.lHow = DIPH_DEVICE diProp.lObj = 0 diProp.lData = BufferSize diDev.SetProperty "  IPROP_BUFFERSIZE", diProp
diDev.Acquire InitDI = True End Function Private Sub Form_Load() Me.Show If Not InitDI() Then MsgBox "Îøèáêà èíèöèàëèçàöèè DirectInput.", vbCritical End End If Timer1.Enabled = True End Sub Private Sub Timer1_Timer() List1.Clear Dim NumItems As Integer Dim i As Integer On Error GoTo diError NumItems = diDev.GetDeviceData(diDeviceData, DIGDD_DEFAULT) For i = 1 To NumItems Select Case diDeviceData(i).lOfs Case DIMOFS_BUTTON0 If diDeviceData(i).lData <> 0 Then List1.AddItem "Íàæàòà ëåâàÿ êíîïêà ìûøè" Else List1.AddItem "Îòïóùåíà ëåâàÿ êíîïêà ìûøè" End If Case DIMOFS_BUTTON1 If diDeviceData(i).lData <> 0 Then List1.AddItem "Íàæàòà ïðàâàÿ êíîïêà ìûøè" Else List1.AddItem "Îòïóùåíà ïðàâàÿ êíîïêà ìûøè" End If Case DIMOFS_X List1.AddItem "Ñäâèã âäîëü îñè X:" & Str(diDeviceData(i).lData) Case DIMOFS_Y List1.AddItem "Ñäâèã âäîëü îñè Y:" & Str(diDeviceData(i).lData) Case DIMOFS_Z List1.AddItem "Ñäâèã âäîëü îñè Z:" & Str(diDeviceData(i).lData) End Select Next i Exit Sub diError: MsgBox "Input error." End Sub Private Sub CleanUp() diDev.Unacquire Set diDev = Nothing Set DI = Nothing End Sub Комментарии исправлять не стал, там и так все понятно. |
||
|
Номер ответа: 8 Автор ответа: LamerOnLineICQ: 334781088 Вопросов: 108 Ответов: 2822 |
Профиль | | #8 | Добавлено: 12.10.04 15:38 |
Не, все хуже чем я думал...  Ладно
Часто помимо работы с клавиатурой приложение должно уметь работать и с мышью. В этом учебнике мы рассмотрим два способа работы с мышью. Первый из них мало отличается от рассмотренного в предыдущей части учебника, а второй использует буферизированные данные. Работа с мышью - 1 Начнём с нескольких объявлений: Dim DX As New DirectX8 'объект DirectX Dim DI As DirectInput8 'объект DirectInput Dim diDev As DirectInputDevice8 ' устройство DirectInput Dim diState As DIMOUSESTATE 'структура для хранения состояния мыши Функция, инициализирующая DirectInput будет такой: Public Function InitDI() As Boolean Set DI = DX.DirectInputCreate If DI Is Nothing Then Exit Function Set diDev = DI.CreateDevice("guid_SysMouse"
If diDev Is Nothing Then Exit Function diDev.SetCommonDataFormat DIFORMAT_MOUSE diDev.SetCooperativeLevel Me.hWnd, DISCL_NONEXCLUSIVE Or DISCL_BACKGROUND diDev.Acquire InitDI = True End Function Для создания устройства, при помощи которого мы будем получать данные о состоянии мыши был использован метод CreateDevice объекта DirectInput с параметром "guid_SysMouse". Затем устанавливается формат данных устройства; так как мы будем работать с мышью, используется константа DIFORMAT_MOUSE. Метод SetCooperativeLevel "присоединяет" устройство к форме, а также устанавливает неэксклюзивный и фоновый режим доступа к устройству. В конце функции для получения доступа к устройству используется метод Acquire. Теперь в любой момент мы можем получить информацию о текущем состоянии мыши. В данном примере это делается в обработчике события Timer объекта Timer1: Private Sub Timer1_Timer() 'текущее сотояние мыши помещается 'в структуру diState diDev.GetDeviceStateMouse diState Label1.BackColor = &H8000000F Label2.BackColor = &H8000000F Label3.BackColor = &H8000000F 'Если нажата какая-то кнопка мыши, то 'соответствующая метка окрашивается в 'красный цвет 'Левая кнопка мыши If diState.Buttons(0) <> 0 Then Label1.BackColor = vbRed 'Правая конпка мыши If diState.Buttons(1) <> 0 Then Label2.BackColor = vbRed 'Средняя кнопка мыши (если её нет - 'то соответствующий элемент в массиве 'всегда равен нулю) If diState.Buttons(2) <> 0 Then Label3.BackColor = vbRed 'В элементы управления Label7-9 'помещается информация о сдвиге 'мыши вдоль соответствующих осей Label7.Caption = diState.lX Label8.Caption = diState.lY Label9.Caption = diState.lZ 'обычно ось Z соответствует вращения колёсика 'если его нет - lZ всегда равно нулю End Sub |
||
|
Номер ответа: 9 Автор ответа: AgentFireICQ: 192496851 Вопросов: 75 Ответов: 3178 |
Профиль | | #9 | Добавлено: 12.10.04 16:16 |
| Хотел лишь заметить, что при вращении колесика вверх Z = 1, вниз – -1 | ||
|
Номер ответа: 10 Автор ответа: xTractorВопросов: 3 Ответов: 11 |
Профиль | | #10 | Добавлено: 13.10.04 11:52 |
|
to LamerOnLine:
Как я понимаю такой пример будет работать только с DirectX 8, если же у пользователя установлена 7 или 9 версия, то - увы, так? Как я понимаю, DirectX имеет обратную совместимость по версиям: могу ли я воспользоватьсмя функциями DirectX 7, так чтобы программа работала так же с 8 и 9 версиями? (Ведь старые игрушки написанные под DirectX 7 зачастую свободно работают под DirectX 8+, или для VB такой вариант реализовать не удастся?) |
||
|
Номер ответа: 11 Автор ответа: LamerOnLineICQ: 334781088 Вопросов: 108 Ответов: 2822 |
Профиль | | #11 | Добавлено: 13.10.04 13:53 |
| Разумеется. Определяй версию DirectX и танцуй от этого. Можно и с 7, и с 8, и с 9. Только вот с 6 и ниже не получится... | ||
Страница: 1 |