[plt-scheme] Event bug under MS Windows

From: Ivanyi Peter (pivanyi at freemail.hu)
Date: Fri Sep 12 19:33:55 EDT 2008

Hi,

The program below tries to simulate a tooltip window.
If you try it under MS Windows and you move the mouse from top 
to bottom over the button, you should notice, that it will
print 
repeatedly:

enter
motion
leave

It is very strange, as when you move the mouse from bottom
to top
over the button it prints one 'enter, a lot of motion and
one 'leave
message. I think this is a bug in MrEd.
Can it be fixed?

Thanks.

Peter Ivanyi

---------------------------------------------------------------------------

(module tooltip mzscheme
  (require (lib "class.ss") (lib "mred.ss" "mred") (lib
"framework.ss" "framework"))

  (define mred-button-tooltip%
    (class button%
      
      (init-field
        (tooltip-text " ")
      )
      
      ; this is the timer
      (define timer #f)
      ; whether the tooltip window is shown
      (define shown? #f)
      ; the tooltip window
      (define tooltip #f)
      
      (define (tooltip:clear)
        (if timer
          (begin
            (send timer stop)
            (set! timer #f)
          )
        )
        (if (and tooltip shown?)
          (begin
            (send tooltip show #f)
            (set! tooltip #f)
            (set! shown? #f)
          )
        )
      )
      
      (define (tooltip:timer)
        (tooltip:clear)
      )
      
      (define (tooltip:setup text x y)
        (let-values
          (((sx sy) (send this client->screen x y)))
          (let*
            ((frame (new frame%
                         (parent #f)
                         (label "")
                         (stretchable-height #f)
                         (stretchable-width #f)
                         (x sx)
                         (y sy)
                         (width 46)
                         (height 17)
                         (border 2)
                         (style '(no-system-menu no-caption
no-resize-border float))
                    )
              )
              (message (new message% (parent frame) (label
text)))
            )
            (set! tooltip frame)
            (set! timer (new timer% (notify-callback
tooltip:timer)
                                    (interval        3000)
                                    (just-once?      #t)
                        ))
            (send tooltip show #t)
            (set! shown? #t)
          )
        )
      )
      
      
      (define/override (on-subwindow-event w e)
        (cond
          ( (equal? (send e get-event-type) 'leave)
            (tooltip:clear)
          )
          ( (member (send e get-event-type) '(enter))
            (if (not shown?)
              (tooltip:setup tooltip-text (send e get-x)
(send e get-y))
            )
          )
        )
          
        
        (display (send e get-event-type))(newline)
        #f
      )
      
      (super-new)
    )
  )
  
  (define f (new frame% (label "Test")))
  (define b (new mred-button-tooltip% (parent f) (label
"Hello") (tooltip-text "Button") ))
  (send f show #t)
  

)


_______________________________________
LEGYÉL TE IS KLIKKBRÓKER! - Befektetési alapok online az [origo] klikkbankban! Ne bízd másra a pénzügyeidet! Kattints!
kérjen ajánlatot most!http://www.klikkbank.hu/klikkbroker/index.html



Posted on the users mailing list.