Модераторы: Akina
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> скроллер в Visual Basic 
:(
    Опции темы
provod
Дата 22.2.2007, 13:12 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 6
Регистрация: 20.9.2006

Репутация: нет
Всего: нет
Нужно создать форму и программу для смены цвета метки на форме с помощью скроллера. 
Помогите советом, не получаеться обработать колесико прокрутки мыши
PM MAIL   Вверх
Black_Star
Дата 22.2.2007, 18:38 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 192
Регистрация: 9.9.2003
Где: Minsk

Репутация: 4
Всего: 4
Код

Option Explicit
Private Declare Function CallWindowProcA Lib "user32" (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 SetWindowLongA Lib "user32" (ByVal Hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const GWL_WNDPROC = -4
Private Const WM_MOUSEWHEEL = &H20A
Private OldWindowProc As Long, MeHWND As Long, MeVS As VScrollBar
Private Const WM_VSCROLL = &H115
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Public Sub HookMouse(Hwnd As Long, VSHwnd As VScrollBar)
  If MeHWND Then UnHookMouse
  MeHWND = Hwnd
  Set MeVS = VSHwnd
  OldWindowProc = SetWindowLongA(Hwnd, GWL_WNDPROC, AddressOf NewWindowProc)
End Sub

Public Function NewWindowProc(ByVal Hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  If Msg = WM_MOUSEWHEEL Then
    Call ObrSob(IIf(wParam < 0, 0, 1))
  End If
  NewWindowProc = CallWindowProcA(OldWindowProc, Hwnd, Msg, wParam, lParam)
End Function

Public Sub UnHookMouse()
  If MeHWND Then
    SetWindowLongA MeHWND, GWL_WNDPROC, OldWindowProc
    MeHWND = 0
  End If
End Sub

Private Sub ObrSob(ByVal wParam As Long)
Dim e As Long
  If wParam Then
    If MeVS.Value > MeVS.Min Then
       e = MeVS.Value - MeVS.LargeChange
       If e < MeVS.Min Then e = MeVS.Min
       MeVS.Value = e
    End If
  Else
    If MeVS.Value < MeVS.Max Then
        e = MeVS.Value + MeVS.LargeChange
        If e > MeVS.Max Then e = MeVS.Max
        MeVS.Value = e
    End If
  End If

End Sub


Кажись сей код когда-то работал... Вызывать HookMouse (me.hwnd, Vscroll1.hwnd)
PM ICQ   Вверх
provod
Дата 23.2.2007, 20:05 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 6
Регистрация: 20.9.2006

Репутация: нет
Всего: нет
Дружище помоги ещё разобраться с кодом, как метку назвать и что значит "user32"?
PM MAIL   Вверх
~FoX~
Дата 23.2.2007, 20:10 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


НЕ рыжий!!!
****


Профиль
Группа: Участник Клуба
Сообщений: 2819
Регистрация: 8.10.2003
Где: Зеленоград

Репутация: 10
Всего: 68
Цитата(provod @  23.2.2007,  21:05 Найти цитируемый пост)
что значит "user32"

Библиотека так называется...


--------------------
user posted image
…множественность никогда не следует полагать без необходимости…
PM MAIL WWW ICQ Jabber   Вверх
provod
Дата 23.2.2007, 20:40 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 6
Регистрация: 20.9.2006

Репутация: нет
Всего: нет
как под этот код форму создать?
PM MAIL   Вверх
bom
Дата 25.2.2007, 19:43 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 329
Регистрация: 22.2.2004
Где: Казахстан, Алматы

Репутация: 4
Всего: 6
По мере приобретения базовых знаний по VB вопрос отпадет сам собой.
PM MAIL   Вверх
Black_Star
Дата 26.2.2007, 17:54 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 192
Регистрация: 9.9.2003
Где: Minsk

Репутация: 4
Всего: 4
provod, мой пример кидаешь в модуль !
Вызываешь из формы, из любого места!
Только в редакторе надо быть осторожным - саблассинг не терпит ошибок... По выходы из проги/формы обязательно делать UnHook !
PM ICQ   Вверх
provod
Дата 27.2.2007, 14:09 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 6
Регистрация: 20.9.2006

Репутация: нет
Всего: нет
спаисобо дружище, у начиющих всегда смешные воросы, но слава тем кто имеет силу воли отвечать на эти вопросы!
PM MAIL   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "VB6"
Akina

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по VB обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • Используйте теги [code=vb][/code] для подсветки кода. Используйтe чекбокс "транслит" (возле кнопок кодов) если у Вас нет русских шрифтов.

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Akina.
 
1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | VB6 | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0827 ]   [ Использовано запросов: 21 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.