added a close icon to the yellow warning message

svn: r15611

original commit: 3c4bdf86feeda27ad9de986bf357d1a65fda79c0
This commit is contained in:
Robby Findler 2009-07-28 20:40:54 +00:00
parent 8cb584ee8b
commit 3e64e5f4fb
2 changed files with 10 additions and 1 deletions

View File

@ -55,7 +55,8 @@
(class canvas% (class canvas%
(inherit get-dc min-width min-height stretchable-width stretchable-height (inherit get-dc min-width min-height stretchable-width stretchable-height
get-client-size refresh) get-client-size refresh)
(init-field [callback void]) (init-field [callback void]
[bg-color #f])
(init [horizontal-pad 4] (init [horizontal-pad 4]
[vertical-pad 4]) [vertical-pad 4])
(init-masks) (init-masks)
@ -92,6 +93,11 @@
(define/override (on-paint) (define/override (on-paint)
(let ([dc (get-dc)]) (let ([dc (get-dc)])
(let-values ([(cw ch) (get-client-size)]) (let-values ([(cw ch) (get-client-size)])
(when bg-color
(send dc set-brush bg-color 'solid)
(send dc set-pen bg-color 1 'transparent)
(let-values ([(w h) (get-client-size)])
(send dc draw-rectangle 0 0 w h)))
(send dc draw-bitmap icon (send dc draw-bitmap icon
(- (/ cw 2) (/ (send icon get-width) 2)) (- (/ cw 2) (/ (send icon get-width) 2))
(- (/ ch 2) (/ (send icon get-height) 2)) (- (/ ch 2) (/ (send icon get-height) 2))

View File

@ -13,8 +13,11 @@ provides a clickable close button icon.}
@defclass[close-icon% canvas% ()]{ @defclass[close-icon% canvas% ()]{
@defconstructor[([parent (is-a? area-container<%>)] @defconstructor[([parent (is-a? area-container<%>)]
[callback (-> any) void] [callback (-> any) void]
[bg-color (or/c #f string (is-a?/c color%))]
[horizontal-pad positive-integer? 4] [horizontal-pad positive-integer? 4]
[vertical-pad positive-integer? 4])]{ [vertical-pad positive-integer? 4])]{
The @scheme[callback] is called when the close icon is clicked. The @scheme[callback] is called when the close icon is clicked.
If @scheme[bg-color] is specified, it is used as the background color of the icon.
} }
} }