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

.

Browse Source 
original commit: 9a07cba08a031ffa2e02791f0453f313770eb577
This commit is contained in:
Matthew Flatt 1999-02-23 18:04:10 +00:00
parent 8b691f927a
commit 3c72c97010
2 changed files with 17 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
collects/tests/mred/draw.ss
View File

@ -115,7 +115,7 @@
(let* ([ofont (send dc get-font)]
[otfg (send dc get-text-foreground)]
[otbg (send dc get-text-background)]
[obm (send dc get-background-mode)])
[obm (send dc get-text-mode)])
(if (positive? flevel)
(send dc set-font
(make-object font%
@ -136,7 +136,7 @@
(send dc set-text-background (make-object color% "YELLOW"))
(when (= flevel 2)
(send dc set-text-foreground (make-object color% "RED"))
(send dc set-background-mode 'solid))
(send dc set-text-mode 'solid))
(send dc draw-text (string-append size " Pen")
(+ x 5) (+ y 8))
@ -144,7 +144,7 @@
(when (= flevel 2)
(send dc set-text-foreground otfg)
(send dc set-background-mode obm))
(send dc set-text-mode obm))
(send dc set-text-background otbg)
(send dc draw-line
@ -421,6 +421,19 @@
(loop (cdr fam) (cdr stl) (cdr wgt) (cdr sze) x (+ y h))))))
(send dc set-pen save-pen)))
(when last?
(let ([m (send dc get-text-mode)]
[b (send dc get-brush)]
[p (send dc get-pen)])
(send dc set-pen pen1t)
(send dc set-brush brushs)
(send dc draw-rectangle 295 210 30 20)
(send dc set-text-mode 'xor)
(send dc draw-text "xor" 290 210)
(send dc set-text-mode m)
(send dc set-pen p)
(send dc set-brush b)))
; Bitmap copying:
(when (and (not no-bitmaps?) last?)
(let ([x 5] [y 165])

2
src/mred/wrap/mred.ss
View File

@ -4078,7 +4078,7 @@
(let ([mb (make-object menu-bar% frame)])
(let ([m (make-object menu% "&File" mb)])
(make-object menu-item% "Load File..." m (lambda (i e) (let ([f (get-file)]) (and f (evaluate (format "(load ~s)" f))))))
(make-object menu-item% "Load File..." m (lambda (i e) (let ([f (get-file #f frame)]) (and f (evaluate (format "(load ~s)" f))))))
(make-object menu-item%
(if (eq? (system-type) 'windows)
"E&xit"