Silverfrost Forums

Welcome to our forums

Problem With Mouse Wheel

12 Mar 2012 10:22 #9798

A small example from Paul Laidler dated Jun 16, 2010 showing the use of the mouse wheel works fine. However, as soon as I add e.g. a button to the window ( e.g. %`^rb[Control] ), the mouse wheel is not working as expected anymore.

A just started application gives the focus to this button.

When I move the mouse across the graphics area, the call back function is called. The same is true for MOUSE_MIDDLE_CLICK, MOUSE_RIGHT_CLICK, and as well for MOUSE_LEFT_CLICK as long as the mouse is inside the graphics area.

But MOUSE_WHEEL does not work if the %gr graphics area does not have the focus. I.e.: I have to use MOUSE_LEFT_CLICK inside the graphics area every time after the graphics area has lost the focus.

My graphic has many buttons and other controls, and my large screen has a lot of windows. It is a pain – and not acceptable for my clients – to click every time into the graphics to be able to zoom.

Any work around? Any idea?

Thanks, Erwin

12 Mar 2012 10:38 #9800

It would help if you could post a small sample program. Then I might be able to find a fix or a work-around.

12 Mar 2012 10:55 #9804

!-----------------------------------------------------------------------------------------------------------------------------------

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]&amp;', 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'    &amp;
     .OR. Reason .EQ. 'MOUSE_MIDDLE_CLICK' .OR. REASON .EQ. 'MOUSE_MIDDLE_RELEASE'  &amp;
     .OR. Reason .EQ. 'MOUSE_RIGHT_CLICK'  .OR. REASON .EQ. 'MOUSE_RIGHT_RELEASE'   &amp;
     .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 !-----------------------------------------------------------------------------------------------------------------------------------

12 Mar 2012 11:22 #9806

Erwin, perhaps this can help:

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 
!!!
external  maus_zoom
!!!
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
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@('%mg&',Z'020A',maus_zoom)
!!!
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 
!-----------------------------------------------------------------------------------------------------------------------------------

!!!
      INTEGER FUNCTION MAUS_ZOOM()

      IMPLICIT NONE
      INCLUDE <WINDOWS.INS>

      integer*4     i,j,WPARAM

      WPARAM = CLEARWIN_INFO@('MESSAGE_WPARAM')
      i = HIWORD@(WPARAM)

      if (i .gt. 0) then
        write (*, '(A20)') 'increasing zoom '
      else
        write (*, '(A20)') 'decreasing zoom '
      end if
 
      maus_zoom = 3
      end
!!!

I've marked my changes with '!!!'. Within my function maus_zoom use the parameter i to increase or decrease your zoom factor.

Regards - Wilfried

12 Mar 2012 11:23 #9807

... continue:

to increase or decrease your zoom factor.

Regards - Wilfried

12 Mar 2012 2:16 #9812

Thanks, Wilfried.

It's possible to use this, however, it will be a little clumsy: As soon as the graphics region has the focus, both callbacks Maus_Zoom and DrawOnScreen will be called in sequence.

Regards, Erwin

12 Mar 2012 2:29 #9813

Furthermore it conflicts with %ls.

12 Mar 2012 8:14 #9816

Erwin,

Check your use of %pv. I have a variation which I find works well. Also, I keep statistics on the call back reasons. It is interesting to see them.

module wheelie
!
   INTEGER*4    irb_Control
   INTEGER*4    GR_HANDLE
   INTEGER*4    ptr_RGB_Address
   integer*4    last_RGB_Address
   INTEGER*4    iCurrDrawSizeX
   INTEGER*4    iCurrDrawSizeY
   integer*4    lx_pos, ly_pos
   INTEGER*4    num_reason
   INTEGER*4    reason_count(100)
   character*40 reason_list(100) 
!
end module wheelie

Program Wheel 
!IMPLICIT NONE 
!
use wheelie
!
INCLUDE <windows.ins> 
!
INTEGER MA, hwnd
INTEGER  DrawOnScreen, update
EXTERNAL DrawOnScreen, update
!
GR_HANDLE        = 101 
iCurrDrawSizeX   = 300 
iCurrDrawSizeY   = 300 
irb_Control      = 0 
num_reason       = 0
last_RGB_Address = -1
lx_pos           = -1
ly_pos           = -1
!
MA = WINIO@ ('%ca[Wheel Test]&')
MA = WINIO@ ('%bg[grey]&') 
MA = WINIO@ ('%ww[no_border]&') 
MA = WINIO@ ('%ff&')
MA = WINIO@ ('%`^rb[Control]&', irb_Control, update) 
MA = WINIO@ ('%pv&')
MA = WINIO@ ('%`^gr[grey, rgb_colours, user_resize, full_mouse_input, user_surface]&',    &
             iCurrDrawSizeX, iCurrDrawSizeY, ptr_RGB_Address, GR_HANDLE, DrawOnScreen)
ma = winio@ ('%hw', hwnd) 
END Program Wheel 

INTEGER FUNCTION DrawOnScreen () 
!
use wheelie

INCLUDE <windows.ins> 

INTEGER iX_Pos, iY_Pos, iFlags, iDelta, dx
CHARACTER reason*256 
!
if ( ptr_RGB_Address /= last_RGB_Address) then
   reason = 'change to RGB Address'
   call add_reason (reason)
   last_RGB_Address = ptr_RGB_Address
end if

Reason = clearwin_string@ ('CALL_BACK_REASON') 
!
call add_reason (reason)
!
IF (Reason .EQ. 'RESIZE') THEN 

   iCurrDrawSizeX = Clearwin_Info@ ('GRAPHICS_WIDTH') 
   iCurrDrawSizeY = Clearwin_Info@ ('GRAPHICS_DEPTH') 

   write (*, '(A24, 2I6,i12)') TRIM(Reason), iCurrDrawSizeX, iCurrDrawSizey, ptr_RGB_Address 

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') 
!
   dx = abs(ix_pos-lx_pos) + abs(iy_pos-ly_pos)
! ... 
   if (dx > 20) then
      write (*, '(A24, 2I6)') TRIM(Reason), iX_Pos, iY_Pos 
      lx_pos = ix_pos
      ly_pos = iy_pos
!
      reason = 'Report_MOUSE_MOVE'
      call add_reason (reason)
   end if
   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_RIGHT_RELEASE' ) THEN
   write (*, '(A24, 12x, I12)') TRIM(Reason), ptr_RGB_Address 
   call report_reason
   GOTO 90 

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

! ... 
12 Mar 2012 8:17 #9817

code ... ! ...

   write (*, '(A24, 12x, I12)') TRIM(Reason), ptr_RGB_Address 
   GOTO 90 

else
   write (*, '(A24, 12x, I12, a)') TRIM(Reason), ptr_RGB_Address, ' Other' 
   GOTO 90 

ENDIF 

CALL DRAW_FILLED_RECTANGLE@ (0,0,iCurrDrawSizeX,iCurrDrawSizeY,15) ! White 

90 DrawOnScreen = 1 
RETURN 
END FUNCTION DrawOnScreen 

subroutine add_reason (reason)
!
use wheelie
!
character reason*40
integer i
!
do i = 1,num_reason
   if (reason_list(i) == reason) exit
end do
if (i > num_reason) then
   num_reason = i
   reason_list(i) = reason
   reason_count(i) = 1
else
   reason_count(i) = reason_count(i) + 1
end if
end

subroutine report_reason
!
use wheelie
!
integer i
!
do i = 1,num_reason
   write (*,fmt='(2i6,2x,a)') i,reason_count(i),reason_list(i)
end do
end

INTEGER FUNCTION update () 
!
use wheelie
!
INCLUDE <windows.ins> 
!
CHARACTER reason*256 
!
Reason = clearwin_string@ ('CALL_BACK_REASON') 
!
call add_reason (reason)
!
call report_reason
!
CALL DRAW_FILLED_RECTANGLE@ (0,0,iCurrDrawSizeX,iCurrDrawSizeY,15) ! White 

update = 1 
RETURN 
END FUNCTION update 

I find the change to %ww and the location of %pv before %gr works. I also link the reporting of reasons to the Exit. There are many ways to use clearwin!

13 Mar 2012 7:53 #9820

Thanks for your effort, John. However I cannot find any difference to my first code regarding the mouse wheel? I use FTN95 6.20 on Win XP x64. Erwin

13 Mar 2012 10:12 #9822

I found an easy solution: I call SetFocus from Windows API as soon as the callback reason was MOUSE_MOVE :

    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

         iRet = SetFocus (GR_HANDLE)

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  (.... 
13 Mar 2012 10:22 #9823

Maybe %if will also do this for you.

14 Mar 2012 1:37 #9825

I had tried that already. It does not help.

Please login to reply.