suzanne.soy/gui
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

.

Browse Source 
original commit: 59653202b5ba3bbdd1fd34278e99a3f4a6a00645
This commit is contained in:
Matthew Flatt 2004-02-06 12:46:58 +00:00
parent 864c1b8c6d
commit 80adce5ab3
1 changed files with 14 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
collects/tests/mred/item.ss
View File

@ -33,7 +33,9 @@
x y w h x y w h
(if mdi-frame (if mdi-frame
(cons 'mdi-child style) (cons 'mdi-child style)
style)))) (if use-metal?
(cons 'metal style)
style)))))
(define special-font (send the-font-list find-or-create-font (define special-font (send the-font-list find-or-create-font
20 'decorative 20 'decorative
@ -529,6 +531,7 @@
(list "Panel" (lambda () (instantiate panel% (panel) [style '(deleted border)])))))) (list "Panel" (lambda () (instantiate panel% (panel) [style '(deleted border)]))))))
(define use-dialogs? #f) (define use-dialogs? #f)
(define use-metal? #f)
(define (big-frame h-radio? v-label? null-label? stretchy? special-label-font? special-button-font? (define (big-frame h-radio? v-label? null-label? stretchy? special-label-font? special-button-font?
initially-disabled? alternate-init?) initially-disabled? alternate-init?)
@ -1744,7 +1747,8 @@
(define f (new frame% (define f (new frame%
[label "No-Clear Canvas Test"] [label "No-Clear Canvas Test"]
[height 250] [height 250]
[width 300])) [width 300]
[style '(metal)]))
(define p (make-object vertical-panel% f)) (define p (make-object vertical-panel% f))
(define c% (class canvas% (define c% (class canvas%
(inherit get-dc refresh) (inherit get-dc refresh)
@ -1756,9 +1760,11 @@
(let loop ([x 0]) (let loop ([x 0])
(unless (= x 500) (unless (= x 500)
(send dc set-brush red) (send dc set-brush red)
(send dc draw-rectangle (- x delta) 0 25 400) (send dc draw-rectangle (- x delta) 0 25 30)
(send dc draw-rectangle (- x delta) 40 25 390)
(send dc set-brush blue) (send dc set-brush blue)
(send dc draw-rectangle (- (+ x 25) delta) 0 25 400) (send dc draw-rectangle (- (+ x 25) delta) 0 25 30)
(send dc draw-rectangle (- (+ x 25) delta) 40 25 390)
(loop (+ x 50)))))) (loop (+ x 50))))))
(define/override (on-event evt) (define/override (on-event evt)
(when (send evt dragging?) (when (send evt dragging?)
@ -1766,6 +1772,7 @@
(refresh))) (refresh)))
(super-new))) (super-new)))
(new c% [parent p][style '(border)]) (new c% [parent p][style '(border)])
(new c% [parent p][style '(transparent)])
(new c% [parent p][style '(no-autoclear border)]) (new c% [parent p][style '(no-autoclear border)])
(send f show #t) (send f show #t)
f) f)
@ -1967,6 +1974,9 @@
(make-object check-box% "Position via Style" clockp (make-object check-box% "Position via Style" clockp
(lambda (c e) (lambda (c e)
(set! position-via-style? (send c get-value)))) (set! position-via-style? (send c get-value))))
(make-object check-box% "Metal" clockp
(lambda (c e)
(set! use-metal? (send c get-value))))
(make-object vertical-panel% clockp) ; filler (make-object vertical-panel% clockp) ; filler
(let ([time (make-object message% "XX:XX:XX" clockp)]) (let ([time (make-object message% "XX:XX:XX" clockp)])
(make-object (make-object