The central issue is that canvas% doesn't support the 'auto-vscroll style (like editor-canvas% and horizontal-panel%, for example). So when resizing an element so that the pict displayed in the canvas extends out of sight (even with 'vscroll), there's no scroll bar to recover the full image.
I've tried a few invocations of (send this init-auto-scrollbars …) (largely via the #:mixin argument for GUI Easy's pict-canvas), but nothing worked in the way I was hoping: I could never make a useable scrollbar "thumb" appear after resizing the example window from (2) so that the canvas was smaller than the pict.
I did go peeking around mrcanvas and the wxme/gtk/cocoa canvas files, but I got confused. It seems the latter all support 'auto-vscroll but the former doesn't? It was never clear to me which actual canvas definition was relevant, and then the code for editor-canvas% was convoluted enough that I had a difficult time understanding how it implemented 'auto-vscroll.
If anyone knows a way to make scrollbars in canvas% work (especially via a mixin), please let me know.
It looks like the 'auto-vscroll and 'auto-hscroll styles are not supported for canvas% objects, but they are easy to implement. Below is an example on how to do it. My implementation assumes that init-auto-scrollbars is only called once, so the virtual canvas size never changes, but you can override that method as well to trigger the showing of scrollbars, as it is done for on-size.
hope this helps,
Alex.
#lang racket/gui
;; a canvas% object supporting 'auto-hscroll and 'auto-vscroll styles
(define auto-scroll-canvas%
(class canvas%
(init [style null])
(define auto-hscroll? (member 'auto-hscroll style))
(define auto-vscroll? (member 'auto-vscroll style))
(define hscroll? (member 'hscroll style))
(define vscroll? (member 'vscroll style))
;; Replace auto-scroll options in style with plain scroll options and pass
;; it on to the super class...
(let* ([c (remf* (lambda (v) (member v '(auto-hscroll auto-vscroll hscroll vscroll))) style)]
[h (if (or hscroll? auto-hscroll?) (cons 'hscroll c) c)]
[v (if (or vscroll? auto-vscroll?) (cons 'vscroll h) h)])
(super-new [style v]))
;; Enable/Disable scroll bars if the virtual canvas size is larger than
;; the client area
(define/override (on-size window-width window-height)
(define-values (w h) (send this get-client-size))
(define-values (vw vh) (send this get-virtual-size))
(send this show-scrollbars
(or hscroll? (and auto-hscroll? (> vw w)))
(or vscroll? (and auto-vscroll? (> vh h)))))
))
(define the-frame (new frame% [label "Canvas Test"] [width 200] [height 200]))
(define the-canvas (new auto-scroll-canvas% [parent the-frame] [style '(auto-vscroll auto-hscroll)]))
(send the-canvas init-auto-scrollbars 400 400 0 0)
(send the-frame show #t)
I'm just now getting around to trying to integrate this with GUI Easy. I noticed that in your demo scrolling with the mouse doesn't scroll the canvas (click-dragging the scrollbars works).
I couldn't add those via a mixin on canvases because I couldn't update the automatic scroll bar positions in a reasonable way—I expected to be able to retrieve auto-scroll-bar positions to calculate new values (or at least to be able to track positions myself using on-scroll, but the passed scroll event doesn't seem to give me what I need for that).
To use the mouse wheel scroll, you need to override the on-char event to handle the 'wheel-up and 'wheel-down events and call the scroll method with the appropriate parameters. Below is an example on how this could be done, although, depending on what application requirements you have, you might need to update the code or use some other strategy.
I also added the 'wheel-left and 'wheel-right handlers, for horizonal scrolling - the trackpad of my laptop does generate these key codes, but I'm not sure if other trackpads do.
Alex.
#lang racket/gui
;; a canvas% object supporting 'auto-hscroll and 'auto-vscroll styles
(define auto-scroll-canvas%
(class canvas%
(init [style null])
(define auto-hscroll? (member 'auto-hscroll style))
(define auto-vscroll? (member 'auto-vscroll style))
(define hscroll? (member 'hscroll style))
(define vscroll? (member 'vscroll style))
;; Replace auto-scroll options in style with plain scroll options and pass
;; it on to the super class...
(let* ([c (remf* (lambda (v) (member v '(auto-hscroll auto-vscroll hscroll vscroll))) style)]
[h (if (or hscroll? auto-hscroll?) (cons 'hscroll c) c)]
[v (if (or vscroll? auto-vscroll?) (cons 'vscroll h) h)])
(super-new [style v]))
;; Enable/Disable scroll bars if the virtual canvas size is larger than
;; the client area
(define/override (on-size window-width window-height)
(define-values (w h) (send this get-client-size))
(define-values (vw vh) (send this get-virtual-size))
(send this show-scrollbars
(or hscroll? (and auto-hscroll? (> vw w)))
(or vscroll? (and auto-vscroll? (> vh h)))))
(define (do-vscroll percent)
(define-values (vw vh) (send this get-virtual-size))
(define-values (cw ch) (send this get-client-size))
(define-values (x y) (send this get-view-start))
(define v-value
(let ([v (/ y (- vh ch))])
(min 1.0 (max 0.0 (+ v percent)))))
(send this scroll #f v-value))
(define (do-hscroll percent)
(define-values (vw vh) (send this get-virtual-size))
(define-values (cw ch) (send this get-client-size))
(define-values (x y) (send this get-view-start))
(define h-value
(let ([v (/ x (- vw cw))])
(min 1.0 (max 0.0 (+ v percent)))))
(send this scroll h-value #f))
(define/override (on-char event)
(case (send event get-key-code)
((wheel-up) (do-vscroll -1/100))
((wheel-down) (do-vscroll 1/100))
((wheel-left) (do-hscroll -1/100))
((wheel-right) (do-hscroll 1/100))
(else (super on-char event))))
))
(define the-frame (new frame% [label "Canvas Test"] [width 200] [height 200]))
(define the-canvas (new auto-scroll-canvas% [parent the-frame] [style '(auto-vscroll auto-hscroll)]))
(send the-canvas init-auto-scrollbars 1000 1000 0 0)
(send the-frame show #t)
