Fixes for PNG conversion, and make `image-snip%' convertible.
This commit is contained in:
parent
d92ce41a6f
commit
13cae20838
|
@ -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)
|
||||
|
|
|
@ -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<%>)
|
||||
|
|
Loading…
Reference in New Issue
Block a user