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

PR 10635

Browse Source 
svn: r17156
This commit is contained in:
Robby Findler 2009-12-02 04:42:35 +00:00
parent 6639a29829
commit 4c18e8212f
2 changed files with 21 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
collects/2htdp/tests/test-image.ss
View File

@ -954,3 +954,22 @@
16)
(check-equal? (image-height (bitmap icons/stop-16x16.png))
16)
(check-equal? (let ()
(define bmp (make-object bitmap% 4 4))
(define mask (make-object bitmap% 4 4))
(define bdc (make-object bitmap-dc% bmp))
(send bdc set-brush "black" 'solid)
(send bdc draw-rectangle 0 0 4 4)
(send bdc set-bitmap mask)
(send bdc set-brush "black" 'solid)
(send bdc clear)
(send bdc draw-rectangle 1 1 1 1)
(send bdc set-bitmap #f)
(let-values ([(bytes w h) (bitmap->bytes bmp mask)])
bytes))
(bytes-append #"\0\0\0\0" #"\0\0\0\0" #"\0\0\0\0" #"\0\0\0\0"
#"\0\0\0\0" #"\377\0\0\0" #"\0\0\0\0" #"\0\0\0\0"
#"\0\0\0\0" #"\0\0\0\0" #"\0\0\0\0" #"\0\0\0\0"
#"\0\0\0\0" #"\0\0\0\0" #"\0\0\0\0" #"\0\0\0\0"))

4
collects/mrlib/private/image-core-bitmap.ss
View File

@ -59,8 +59,8 @@ instead of this scaling code, we use the dc<%>'s scaling code.
[h (send bm get-height)]
[bytes (make-bytes (* w h NUM-CHANNELS) 0)])
(send bm get-argb-pixels 0 0 w h bytes #f)
(when (send bm get-loaded-mask)
(send (send bm get-loaded-mask) get-argb-pixels 0 0 w h bytes #t))
(when mask
(send mask get-argb-pixels 0 0 w h bytes #t))
(values bytes w h)))
(define (bytes->bitmap bytes w h)