[plt-scheme] Scrollbar/Panel Graphical Toolbox

Thanks for the feedback.

Since there is no scrollbar I implemented a simple  workaround. In  
case anyone else would like to have a scrollbar maybe this  
implementation can help.

I tested it on Mac OS X Tiger, any feedback indicating if this  
implementation works correctly on any other platform would be nice.

Rainer

-------- scroll-bar% and example --------

(define scroll-bar%
   (class canvas%
     (override on-scroll)
     (init-field
      (length 100)
      (page 10)
      (value 0)
      (direction 'vertical) ; one of 'vertical or 'horizontal
      (callback null) ; (lambda (v) ...) with v current scrollbar value
      )

     (public
       set-length-and-page ; (send <> set-length-and-page length page)
       )

     (define on-scroll (lambda (e)
                         (if
                          (eq? (send e get-direction) direction)
                          (set! value (send e get-position)))
                         (if callback (callback value))
                         ))
     (cond
       ((eq? direction 'vertical)
        (super-new (min-width 0) (stretchable-width #f) (style  
'(vscroll))))
       ((eq? direction 'horizontal)
        (super-new (min-height 0) (stretchable-height #f) (style  
'(hscroll))))
      )
     (define update-scroll-bar-values
       (lambda ()
         (send this init-manual-scrollbars length length page page  
value value)))

     (update-scroll-bar-values)

     (define set-length-and-page
       (lambda (l p)
         (set! length l)
         (set! page p)
         (set! value 0)
         (update-scroll-bar-values)
         (if callback (callback value))
         ))
     ))
(define showframe
   (lambda ()
     (let* (
            (f (new frame% (label "TestFrame")))
            (hz (new horizontal-panel% (parent f)))
            (hz2 (new horizontal-panel% (style '(border)) (parent hz)))
            (tb (new text-field% (parent hz2) (label "vert bar")))
            (tb2 (new text-field% (parent hz2) (label "hoz bar")))
            (sb1 (new scroll-bar%
                     (parent hz)
                     (min-height 500)
                     (callback (lambda (v) '()
                                 (send tb set-value (number->string v))
                                 ))
                     ))
            (sb2 (new scroll-bar%
                      (parent f)
                      (direction 'horizontal)
                      (min-width 500)
                      (callback (lambda (v) '()
                                  (send tb2 set-value (number->string  
v))
                                  ))
                      ))
            (b (new button%
                    (label "set hoz scroll bar")
                    (callback
                     (lambda (b e)
                       (send sb2 set-length-and-page
                             (string->number (send tb get-value))
                             (string->number (send tb2 get-value)))))
                    (parent hz2)))

            )
       (send f show #t))))
(showframe)