Fixes for PNG conversion, and make `image-snip%' convertible.

This commit is contained in:
Sam Tobin-Hochstadt 2010-12-15 13:59:57 -05:00
parent d92ce41a6f
commit 13cae20838
2 changed files with 21 additions and 7 deletions

View File

@ -1,6 +1,6 @@
#lang scheme/base
(require scheme/class
scheme/file
scheme/file file/convertible
"../syntax.ss"
"snip-flags.ss"
"private.ss"
@ -863,7 +863,18 @@
jpeg png png/mask png/alpha
xbm xpm bmp pict))
(defclass* image-snip% internal-snip% (equal<%>)
(define png-convertible<%>
(interface* ()
([prop:convertible
(lambda (img format default)
(case format
[(png-bytes)
(let ([s (open-output-bytes)])
(send (send img get-bitmap) save-file s 'png)
(get-output-bytes s))]
[else default]))])))
(defclass* image-snip% internal-snip% (equal<%> png-convertible<%>)
(inherit-field s-admin
s-flags)
(inherit set-snipclass)

View File

@ -28,6 +28,7 @@ has been moved out).
|#
(require racket/class
racket/draw
racket/gui/base
racket/math
racket/contract
@ -211,13 +212,15 @@ has been moved out).
(define (to-bitmap img)
(let* ([bb (send img get-bb)]
[bm (make-object bitmap%
(add1 (inexact->exact (ceiling (bb-right bb))))
(add1 (inexact->exact (ceiling (bb-bottom bb)))))]
[bdc (make-object bitmap-dc% bm)])
[bm (make-bitmap
(add1 (inexact->exact (ceiling (bb-right bb))))
(add1 (inexact->exact (ceiling (bb-bottom bb)))))]
[bdc (new bitmap-dc% [bitmap bm])])
(send bdc clear)
(render-image img bdc 0 0)
(send bdc get-bitmap)))
(begin0
(send bdc get-bitmap)
(send bdc set-bitmap #f)))
(define image%
(class* snip% (png-convertible<%> equal<%> image<%>)