[plt-scheme] Dragable panels

From: Robby Findler (robby at cs.uchicago.edu)
Date: Wed Jan 5 09:46:23 EST 2005

The panel's sizes are not going to be correct until the window is shown
or until 

    (send win reflow-container)

is called. So, if you stick that in front of the call to
set-percentages, you should be set.

The other problem is a bug in the framework. I've fixed it for v299
(and released it to the CVS archives) but that won't help you with
v208. The bug was that the resizable panel wasn't taking the
graphical-min-size into account, only the min-size. Essentially this
means that it wasn't looking at the panel's contents to find the
minimum size. You can hack around this by making (in this case) the
hbox's min-size be it's graphical-min-size, like this:

  (let-values ([(w h) (send hbox get-graphical-min-size)])
    (send hbox min-height h))

This won't work, tho, if the graphical-min-size is changing; you'll
need to call that code again when it changes.

Hope that helps. Revised code below.


(module test mzscheme
  (require (lib "class.ss") 
           (lib "mred.ss" "mred")
           (lib "framework.ss" "framework"))
  (define win (new frame% 
                   (label "test") 
                   (width 500)
                   (height 500)))
  (define vbox (new panel:vertical-dragable% (parent win)))
  (define hbox (new horizontal-panel% (parent vbox)))
  (define my%
    (class canvas% ()
      (inherit get-dc)
      (define/override (on-paint)
        (send (get-dc) draw-ellipse 0 0 100 100))
      (define/override (on-size width height)
        (display (send vbox get-percentages))(newline)
      (super-instantiate ())))
  (define gr  (new my% 
                   (parent hbox)
                   (min-width 100) (min-height 100)))
  (define option (new group-box-panel% (parent hbox)
                      (stretchable-width #f)
                      (label "Option menu")))
  (define history (new text-field%
                       (callback void)
                       (style '(multiple))
                       (label "")
                       (enabled #t)
                       (parent vbox)))
  (send win reflow-container)
  (let-values ([(w h) (send hbox get-graphical-min-size)])
    (send hbox min-height h))
  (send vbox set-percentages '(6/10 4/10))
  (send win show #t))

Posted on the users mailing list.