#lang scheme/gui (require "square-panel.ss") (let* ([frame (new frame% [label "Test of Square Canvas"])] [square-panel (new square-panel% [parent frame] [border 50] [spacing 20] [alignment '(left center)])]) (define (build-canvas stretch? size-x size-y pen-color brush-color) (letrec ([pen (make-object pen% pen-color 1 'solid)] [brush (make-object brush% brush-color 'solid)] [canvas (new canvas% [parent square-panel] [style '()] [min-width size-x] [min-height size-y] [stretchable-width stretch?] [stretchable-height stretch?] [paint-callback (λ (b dc) (let-values ([(w h) (send canvas get-size)]) (let ([dc (send canvas get-dc)]) (send dc set-pen pen) (send dc set-brush brush) (send dc draw-rectangle 0 0 w h) (send dc draw-line 0 0 w h) (send dc draw-line 0 h w 0))))])]) canvas)) (build-canvas #t 100 50 "red" "white") (build-canvas #f 200 100 "green" "black") (build-canvas #t 50 100 "white" "red") (build-canvas #f 150 100 "yellow" "green") (send frame show #t))