在Racket中，我知道如何使用自己的on event方法创建自己的自定义canvas%类：
(define my-canvas%
(class canvas%
(define/override (on-event event)
(cond ...));; handle the event
(super-new)))
我想对(send canvas get-dc)返回的绘图上下文进行类似的更改，以便它有更多的绘图方法。如果我创建了一个自定义的my-dc%类，那么当用get-dc调用时，我必须找到一种方法使my-canvas%返回it，而不是普通的dc%。这可能吗？
更具体地说，my-dc%看起来像这样（我定义的draw-circle应该使用内置的draw-arc）：
(define my-dc%
(class dc%
(define (draw-circle x y radius)
(draw-arc (- x radius) ; left
(- y radius) ; top
(* 2 radius) ; width
(* 2 radius) ; height
0 ; start-angle
(* 2 pi))) ; end-angle
(super-new)))
这样我以后就可以像其他绘图方法一样，用(send dc draw-circle 100 100 20)画一个圆。
您可能可以编写一个容器，将大部分工作委托给包含的dc%。你可以这样做：
#lang racket
(require racket/gui/base)
(define my-dc%
(class* object% (dc<%>)
(init-field delegate)
(super-new)
(define/public (cache-font-metrics-key)
(send delegate cache-font-metrics-key))
(define/public (clear)
(send delegate clear))
(define/public (copy x y width height x2 y2)
(send delegate copy x y width height x2 y2))
(define/public (draw-arc x y width height start-radians end-radians)
(send delegate draw-arc x y width height start-radians end-radians))
;; FILL ME IN...
))
通过CCD_ 11接口中列出的所有方法。诚然，这种方法相当暴力，但它应该有效。然后，您可以向这个类添加任何您想要的额外方法，因为它是您的。
下面是一个完整的例子，使用一些宏来减少我本来会做的大量复制和粘贴：
#lang racket
(require racket/gui/base)
;; Defines a dc<%> implementation that can wrap around
;; another dc.
;;
;; Can also be found at: https://gist.github.com/dyoo/5025445
;;
;; The test code near the bottom shows an example
;; of how to use the delegate.
(define wrapped-dc%
(class* object% (dc<%>)
(init-field delegate)
(super-new)
;; This bit of code tries to generate the delegate method
;; given the method signature. It's not quite perfect
;; yet because I'm having trouble capturing the re-write rule
;; for set-pen and set-brush.
(define-syntax (write-delegate-method stx)
(syntax-case stx ()
[(_ (name args ...))
(with-syntax ([(arg-ids ...)
(for/list ([arg (syntax->list #'(args ...))])
(syntax-case arg ()
[(id default)
#'id]
[id
#'id]))])
#'(define/public (name args ...)
(send delegate name arg-ids ...)))]))
(define-syntax-rule (write-delegate-methods sig ...)
(begin (write-delegate-method sig) ...))
(write-delegate-methods
(cache-font-metrics-key)
(clear)
(copy x y width height x2 y2)
(draw-arc x y width height start-radians end-radians)
(draw-bitmap source dest-x dest-y
(style 'solid)
(color (send the-color-database find-color "black"))
(mask #f))
(draw-bitmap-section source dest-x dest-y src-x src-y
src-width src-height
[style 'solid]
[color (send the-color-database find-color "black")]
[mask #f])
(draw-ellipse x y width height)
(draw-line x1 y1 x2 y2)
(draw-lines points [xoffset 0] [yoffset 0])
(draw-path path
[xoffset 0] [yoffset 0]
[fill-style 'odd-even])
(draw-point x y)
(draw-polygon points
[xoffset 0] [yoffset 0]
[fill-style 'odd-even])
(draw-rectangle x y width height)
(draw-rounded-rectangle x y width height [radius -0.25])
(draw-spline x1 y1 x2 y2 x3 y3)
(draw-text text x y [combine #f] [offset 0] [angle 0])
(end-doc)
(end-page)
(erase)
(flush)
(get-alpha)
(get-background)
(get-brush)
(get-char-height)
(get-char-width)
(get-clipping-region)
(get-device-scale)
(get-font)
(get-gl-context)
(get-initial-matrix)
(get-origin)
(get-pen)
(get-rotation)
(get-scale)
(get-size)
(get-smoothing)
(get-text-background)
(get-text-extent string [font #f] [combine? #f] [offset 0])
(get-text-foreground)
(get-text-mode)
(get-transformation)
(glyph-exists? c)
(ok?)
(resume-flush)
(rotate angle)
(scale x-scale y-scale)
(set-alpha opacity)
(set-background color)
;(set-brush brush) ;; fixme: this is not quite right
(set-clipping-rect x y width height)
(set-clipping-region rgn)
(set-font font)
(set-initial-matrix m)
(set-origin x y)
;(set-pen pen) ;; fixme: this is not quite right
(set-rotation angle)
(set-scale x-scale y-scale)
(set-smoothing mode)
(set-text-background color)
(set-text-foreground color)
(set-text-mode mode)
(set-transformation t)
(start-doc message)
(start-page)
(suspend-flush)
(transform m)
(translate dx dy)
(try-color try result))
;; We'll manually write the methods for set-brush and set-pen
;; because they're case-lambdas and a bit unusual, rather
;; than complicate the macro any further.
(public set-brush)
(define set-brush
(case-lambda [(brush)
(send delegate set-brush brush)]
[(color style)
(send delegate set-brush color style)]))
(public set-pen)
(define set-pen
(case-lambda [(pen)
(send delegate set-pen pen)]
[(color width style)
(send delegate set-pen color width style)]))))
(module+ test
(define bm (make-bitmap 100 100))
(define my-dc (new wrapped-dc% [delegate (send bm make-dc)]))
(send my-dc draw-rectangle 10 10 30 50)
(print bm)
(newline)
(define extended-dc%
(class wrapped-dc%
(super-new)
(inherit draw-arc)
(define/public (draw-circle x y radius)
(draw-arc (- x radius) (- y radius)
(* 2 radius)
(* 2 radius)
0
(* 2 pi)))))
(define bm2 (make-bitmap 100 100))
(define my-new-dc (new extended-dc%
[delegate (send bm2 make-dc)]))
(send my-new-dc set-smoothing 'aligned)
(send my-new-dc draw-circle 50 50 30)
(print bm2))
这里末尾的test模块表明，我们可以封装dc并根据需要对其进行扩展。
Racket应该在surrogate形式中对此有一些内置支持，尽管我不得不承认我还没有尝试过。如果我有时间，我会尝试做一个例子，如果这个答案比上面的有所改进，我会修改它。
不，我认为基于对文档和源代码的查看，不可能更改画布使用的dc<%>的类。
您必须将draw-circle改为一个函数：
(define (draw-circle dc x y radius)
(send dc draw-arc ....))