Подскажите, как отловить события мышки, в частности колесико.
Очень хочется без специальных драйверов сделать возможность управлять скроллингом с помощью мышиного колеса.
И еще вопрос , а Clarion 6 это (управление скроллингом с помощью колеса) есть?
--
Всего доброго,
Ерофеев Анатолий
(Добавление)
Я вешаю субкласс для перехвата события.
Код: Выделить всё
! В глобальных переменных объявить
WHEEL GROUP,PRE(WHEEL) ! Перехват колесика мыши в форме
ID LONG
hWndProc LONG
X1 LONG
Y1 LONG
X2 LONG
Y2 LONG
END
!
! В Inside the GLOBAL MAP
MODULE('API')
vsCallWindowProc(LONG,UNSIGNED,UNSIGNED,UNSIGNED,LONG),LONG,PASCAL,RAW,NAME('CallWindowProcA')
SendMessage(SIGNED,SIGNED,SIGNED,LONG),LONG,PASCAL,NAME('SendMessageA')
END
!
! Для назначения перехвата
INS_WHEEL routine
data
New_Control long
code
New_Control = choose(inlist(last_control{prop:type},create:text,create:spin,create:list)>0,last_control,0)
if New_Control = WHEEL:ID then EXIT . ! на данный объект уже назначен
IF WHEEL:hWndProc then DO DEL_WHEEL . ! Удалить старое назначение на
! предыдущий объект
IF WHEEL:hWndProc then Exit . ! Ошибка удаления старого
WHEEL:ID = New_Control
IF WHEEL:ID
WHEEL:hWndProc = WHEEL:ID{PROP:WndProc} ! сохранить старые значения указателей
WHEEL:ID{PROP:WndProc} = ADDRESS(TakeMessageMouseWheel)
ELSE
WHEEL:hWndProc = WHEEL:ID{PROP:ClientWndProc}
WHEEL:ID{PROP:ClientWndProc} = ADDRESS(TakeMessageMouseWheel)
END
WHEEL:X1 = WHEEL:ID{prop:XPos}
WHEEL:Y1 = WHEEL:ID{prop:YPos}
WHEEL:X2 = WHEEL:ID{prop:width} + WHEEL:X1
WHEEL:Y2 = WHEEL:ID{prop:height}+ WHEEL:Y1
! Удаление перехвата
DEL_WHEEL routine
IF WHEEL:ID
IF (WHEEL:ID{PROP:WndProc} = ADDRESS(TakeMessageMouseWheel)) AND WHEEL:hWndProc
WHEEL:ID{PROP:WndProc} = WHEEL:hWndProc
WHEEL:hWndProc = 0
END
ELSE
IF (WHEEL:ID{PROP:ClientWndProc} = ADDRESS(TakeMessageMouseWheel)) AND WHEEL:hWndProc
WHEEL:ID{PROP:ClientWndProc} = WHEEL:hWndProc
WHEEL:hWndProc = 0
END
END
!Глобальная процедура TakeMessageMouseWheel:
TakeMessageMouseWheel FUNCTION (phWnd,pwMsg,pwParam,plParam ) ! Declare Procedure
! Start of "All SRC Section"
! [Priority 5000]
vsWM_MouseWheel EQUATE(020Ah) ! WM_MouseWheel: 020Ah
WM_KEYDOWN EQUATE(0100h)
WM_CHAR EQUATE(0102h)
WM_SYSKEYDOWN EQUATE(0104h)
WM_VKEYTOITEM EQUATE(002Eh)
WM_KEYUP EQUATE(0101h)
WM_USER_CHAR EQUATE(EVENT:User + WM_CHAR)
X long
Y long
CODE ! to track mouse movement
in IF wMsg = WM_MOUSEMOVE ! window's client area
CASE pwMsg
OF vsWM_MouseWheel
X = mousex()
Y = mousey()
IF (WHEEL:ID=0) or ~(X>=WHEEL:X1 and X<=WHEEL:X2 and Y>=WHEEL:Y1 and Y<=WHEEL:Y2)
IF pwParam < 0 ! Прокрутка вверх или вниз
if SendMessage(0{prop:clienthandle},115h,1,0) then .
ELSE
if SendMessage(0{prop:clienthandle},115h,0,0) then .
END
RETURN(True)
END
!OF Event:MouseUp
;
!OF Event:mousedown
;
OF WM_CHAR
!Message('pwParam=' & pwParam &'!plParam=' & plParam,'WM_CHAR')
if Flow_Control_Text
Post(WM_USER_CHAR,WHEEL:ID)
end
! OF WM_KEYUP
! Message('pwParam=' & pwParam &'!plParam=' & plParam,'KeyUp')
! OF WM_SYSKEYDOWN
! Message('pwParam=' & pwParam &'!plParam=' & plParam,'WM_SYSKEYDOWN')
END
RETURN(vsCallWindowProc(WHEEL:hWndProc,phWnd,pwMsg,pwParam,plParam))--
Best regards,
RusLan
Написал: ClaList(2)
