!-----------------------------------------------------------------------------------------------------------------------------------
Program Wheel
IMPLICIT NONE
INCLUDE <windows.ins>
INTEGER MA
INTEGER irb_Control, GR_HANDLE, iCurrDrawSizeX, iCurrDrawSizeY
common irb_Control, GR_HANDLE, iCurrDrawSizeX, iCurrDrawSizeY
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
INTEGER DrawOnScreen
EXTERNAL DrawOnScreen
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
GR_HANDLE = 101
iCurrDrawSizeX = 300
iCurrDrawSizeY = 300
irb_Control = 0
MA = WINIO@ ('%ca[Wheel Test]%bg[grey]&')
MA = WINIO@ ('%ff%`^rb[Control]&', irb_Control, DrawOnScreen)
MA = WINIO@ ('%`^gr[user_resize,full_mouse_input]&', iCurrDrawSizeX, iCurrDrawSizeY, GR_HANDLE, DrawOnScreen)
MA = WINIO@ ('%pv%ww')
END Program Wheel
!-----------------------------------------------------------------------------------------------------------------------------------
INTEGER FUNCTION DrawOnScreen ()
IMPLICIT NONE
INCLUDE <windows.ins>
INTEGER iX_Pos, iY_Pos, iFlags, iDelta
CHARACTER reason*256
INTEGER irb_Control, GR_HANDLE, iCurrDrawSizeX, iCurrDrawSizeY
common irb_Control, GR_HANDLE, iCurrDrawSizeX, iCurrDrawSizeY
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Reason = clearwin_string@ ('CALL_BACK_REASON')
IF (Reason .EQ. 'RESIZE') THEN
iCurrDrawSizeX = Clearwin_Info@ ('GRAPHICS_WIDTH')
iCurrDrawSizeY = Clearwin_Info@ ('GRAPHICS_DEPTH')
! ...
ELSE IF (Reason .EQ. 'MOUSE_MOVE') THEN
iX_Pos = Clearwin_Info@ ('GRAPHICS_MOUSE_X') ! Get current mouse position
iY_Pos = Clearwin_Info@ ('GRAPHICS_MOUSE_Y')
iY_Pos = iCurrDrawSizeY - iY_Pos ! Set reference for iY_Pos to lower left corner
! ...
write (*, '(A24, 2I6)') TRIM(Reason), iX_Pos, iY_Pos
GOTO 90
ELSE IF (Reason .EQ. 'MOUSE_WHEEL') THEN
iX_Pos = Clearwin_Info@ ('GRAPHICS_MOUSE_X') ! Get current mouse position
iY_Pos = Clearwin_Info@ ('GRAPHICS_MOUSE_Y')
iY_Pos = iCurrDrawSizeY - iY_Pos ! Set reference for iY_Pos to lower left corner
iflags = Clearwin_Info@ ('GRAPHICS_MOUSE_FLAGS')
idelta = Clearwin_Info@ ('GRAPHICS_MOUSEWHEEL_ROTATION')
! ...
write (*, '(A24, 4I6)') TRIM(Reason), iX_Pos, iY_Pos, iFlags, iDelta
ELSE IF (Reason .EQ. 'MOUSE_LEFT_CLICK' .OR. REASON .EQ. 'MOUSE_LEFT_RELEASE' &
.OR. Reason .EQ. 'MOUSE_MIDDLE_CLICK' .OR. REASON .EQ. 'MOUSE_MIDDLE_RELEASE' &
.OR. Reason .EQ. 'MOUSE_RIGHT_CLICK' .OR. REASON .EQ. 'MOUSE_RIGHT_RELEASE' &
.OR. REASON .EQ. 'MOUSE_DOUBLE_CLICK' ) THEN
! ...
write (*, '(A24, 2I6)') TRIM(Reason)
GOTO 90
ENDIF
CALL DRAW_FILLED_RECTANGLE@ (0,0,iCurrDrawSizeX,iCurrDrawSizeY,15) ! White
90 DrawOnScreen = 1
RETURN
END FUNCTION DrawOnScreen
!-----------------------------------------------------------------------------------------------------------------------------------