diff --git a/collects/mrlib/bitmap-label.rkt b/collects/mrlib/bitmap-label.rkt
index 08495da077..36b5e3df2d 100644
--- a/collects/mrlib/bitmap-label.rkt
+++ b/collects/mrlib/bitmap-label.rkt
@@ -1,105 +1,74 @@
-(module bitmap-label mzscheme
-  (require mred
-	   mzlib/class
-	   mzlib/etc
-           mzlib/contract)
+#lang racket/base
+(require racket/gui/base
+         racket/class
+         racket/contract)
 
-  (provide/contract
-   [make-bitmap-label (opt->
-                       (string?
-                        (or/c path-string?
-                               (is-a?/c bitmap%)))
-                       ((is-a?/c font%))
-                       (is-a?/c bitmap%))]
-   [bitmap-label-maker (string?
-			(or/c path-string?
-			       (is-a?/c bitmap%))
-			. -> .
-			(any/c . -> . (is-a?/c bitmap%)))])
+(provide/contract
+ [make-bitmap-label (->* (string?
+                          (or/c path-string?
+                                (is-a?/c bitmap%)))
+                         ((is-a?/c font%))
+                         (is-a?/c bitmap%))]
+ [bitmap-label-maker (-> string?
+                         (or/c path-string? (is-a?/c bitmap%))
+                         (-> any/c (is-a?/c bitmap%)))])
+
+(define (make-bitmap-label text filename-or-bitmap [font normal-control-font])
+  (define outside-margin 2)
+  (define-values (img-bitmap img-width img-height)
+    (let ([q (if (filename-or-bitmap . is-a? . bitmap%)
+                 filename-or-bitmap
+                 (make-object bitmap% filename-or-bitmap 'unknown/mask))])
+      (if (send q ok?)
+          (values q
+                  (send q get-width)
+                  (send q get-height))
+          (let* ([b (make-object bitmap% 1 1)]
+                 [bdc (make-object bitmap-dc% b)])
+            (send bdc clear)
+            (send bdc set-bitmap #f)
+            (values b 0 0)))))
+  (define-values (width height _1 _2) 
+    (let ([tmp-bitmap-dc (make-object bitmap-dc% (make-bitmap 1 1))])
+      (send tmp-bitmap-dc get-text-extent text font)))
+  (define middle-margin (if (and (zero? img-width)
+                                 (zero? img-height))
+                            0
+                            3))
+  (define new-width (inexact->exact
+                     (floor
+                      (+ outside-margin
+                         img-width
+                         middle-margin
+                         width
+                         outside-margin))))
+  (define new-height (inexact->exact
+                      (floor (+ outside-margin
+                                (max img-height height)
+                                outside-margin))))
   
-  (define make-bitmap-label
-    (opt-lambda (text filename-or-bitmap [font normal-control-font])
-      (let*-values ([(outside-margin) 2]
-                    [(img-bitmap-dc img-bitmap img-width img-height)
-                     (let ([mdc (make-object bitmap-dc%)]
-                           [q (if (filename-or-bitmap . is-a? . bitmap%)
-                                  filename-or-bitmap
-                                  (make-object bitmap% filename-or-bitmap 'unknown/mask))])
-                       (if (send q ok?)
-                           (begin (send mdc set-bitmap q)
-                                  (values mdc
-                                          q
-                                          (send q get-width)
-                                          (send q get-height)))
-                           (let ([b (make-object bitmap% 1 1)])
-                             (send mdc set-bitmap b)
-                             (send mdc clear)
-                             (values mdc q 0 0))))]
-                    [(width height descent leading)
-                     (send img-bitmap-dc get-text-extent text font)]
-                    [(middle-margin) (if (and (zero? img-width)
-                                              (zero? img-height))
-                                         0
-                                         3)]
-                    [(new-width) (inexact->exact
-                                  (floor
-                                   (+ outside-margin
-                                      img-width
-                                      middle-margin
-                                      width
-                                      outside-margin)))]
-                    [(new-height) (inexact->exact
-                                   (floor (+ outside-margin
-                                             (max img-height height)
-                                             outside-margin)))]
-                    [(bitmap-dc) (make-object bitmap-dc%)]
-                    [(new-bitmap) (make-object bitmap% new-width new-height)]
-                    [(new-bitmap-mask) (make-object bitmap% new-width new-height)])
-        (send new-bitmap set-loaded-mask new-bitmap-mask)
-        (send img-bitmap-dc set-bitmap #f)
-        (send bitmap-dc set-bitmap new-bitmap-mask)
-        
-        (send bitmap-dc set-font font)
-        (send bitmap-dc set-pen (send the-pen-list find-or-create-pen "black" 1 'solid))
-        (send bitmap-dc set-brush (send the-brush-list find-or-create-brush "black" 'solid))
-        
-        
-        (send bitmap-dc clear)
-        (send bitmap-dc draw-text text 
-              (+ outside-margin img-width middle-margin)
-              (- (/ new-height 2) (/ height 2)))
-        
-        (cond
-          [(send img-bitmap get-loaded-mask)
-           (send bitmap-dc draw-bitmap
-                 (send img-bitmap get-loaded-mask)
-                 outside-margin
-                 (- (/ new-height 2) (/ img-height 2)))]
-          [else
-           (send bitmap-dc draw-rectangle 
-                 outside-margin
-                 (- (/ new-height 2) (/ img-height 2))
-                 img-width
-                 img-height)])
-        
-        (send bitmap-dc set-bitmap new-bitmap)
-        (send bitmap-dc clear)
-        (send bitmap-dc set-pen (send the-pen-list find-or-create-pen "black" 1 'solid))
-        (send bitmap-dc set-brush (send the-brush-list find-or-create-brush "black" 'solid))
-	;; Black rectangle to be masked by text:
-        (send bitmap-dc draw-rectangle 
-              (sub1 (+ outside-margin img-width middle-margin))
-	      0
-              (add1 width) new-height)
-        (send bitmap-dc draw-bitmap
-              img-bitmap
-              outside-margin
-              (- (/ new-height 2) (/ img-height 2)))
-        (send bitmap-dc set-bitmap #f)
+  (define new-bitmap (make-screen-bitmap new-width new-height))
+  (define bitmap-dc (make-object bitmap-dc% new-bitmap))
+  (send bitmap-dc clear)
+  
+  (send bitmap-dc draw-bitmap
+        img-bitmap
+        outside-margin
+        (- (/ new-height 2) (/ img-height 2))
+        'solid
+        (send the-color-database find-color "black")
+        (send img-bitmap get-loaded-mask))
+  
+  (send bitmap-dc set-font font)
+  (send bitmap-dc draw-text text 
+        (+ outside-margin img-width middle-margin)
+        (- (/ new-height 2) (/ height 2)))
+  
+  (send bitmap-dc set-bitmap #f)
+  
+  new-bitmap)
 
-        new-bitmap)))
-      
-  (define (bitmap-label-maker text filename-or-bitmap)
-    (let ([bm (make-bitmap-label text filename-or-bitmap)])
-      (lambda (area-container-window)
-        bm))))
+(define (bitmap-label-maker text filename-or-bitmap)
+  (let ([bm (make-bitmap-label text filename-or-bitmap)])
+    (lambda (area-container-window)
+      bm)))