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

add a #:draw-border? to filled-rounded-rectangle

Browse Source
This commit is contained in:
Robby Findler 2011-11-11 08:12:11 -06:00
parent dfe33f8919
commit 9b4e0ad15a
2 changed files with 12 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/scribblings/slideshow/picts.scrbl
View File

@ -236,7 +236,8 @@ before drawing the rectangle.
pict?] pict?]
[(filled-rounded-rectangle [w real?] [h real?] [(filled-rounded-rectangle [w real?] [h real?]
[corner-radius real? -0.25] [corner-radius real? -0.25]
[#:angle angle real? 0]) [#:angle angle real? 0]
[#:draw-border? draw-border? any/c #t])
pict?])]{ pict?])]{
Unfilled and filled rectangles with rounded corners. The Unfilled and filled rectangles with rounded corners. The
@ -251,6 +252,9 @@ and @racket[height].
The @racket[angle] determines how much the rectangle is The @racket[angle] determines how much the rectangle is
rotated, in radians. rotated, in radians.
If @racket[draw-border?] is @racket[#f], then the pen is set to be transparent
before drawing the rectangle.
} }
@defproc[(bitmap [img (or/c path-string? @defproc[(bitmap [img (or/c path-string?

10
collects/texpict/utils.rkt
View File

@ -308,18 +308,22 @@
w w
h)))) h))))
(define (filled-rounded-rectangle w h [corner-radius -0.25] #:angle [angle 0]) (define (filled-rounded-rectangle w h [corner-radius -0.25] #:angle [angle 0] #:draw-border? [draw-border? #t])
(let ([dc-path (new dc-path%)]) (let ([dc-path (new dc-path%)])
(send dc-path rounded-rectangle 0 0 w h corner-radius) (send dc-path rounded-rectangle 0 0 w h corner-radius)
(send dc-path rotate angle) (send dc-path rotate angle)
(let-values ([(x y w h) (send dc-path get-bounding-box)]) (let-values ([(x y w h) (send dc-path get-bounding-box)])
(dc (λ (dc dx dy) (dc (λ (dc dx dy)
(let ([brush (send dc get-brush)]) (let ([brush (send dc get-brush)]
[pen (send dc get-pen)])
(send dc set-brush (send the-brush-list find-or-create-brush (send dc set-brush (send the-brush-list find-or-create-brush
(send (send dc get-pen) get-color) (send (send dc get-pen) get-color)
'solid)) 'solid))
(unless draw-border?
(send dc set-pen "black" 1 'transparent))
(send dc draw-path dc-path (- dx x) (- dy y)) (send dc draw-path dc-path (- dx x) (- dy y))
(send dc set-brush brush))) (send dc set-brush brush)
(send dc set-pen pen)))
w w
h)))) h))))