如何让canvas%对象响应鼠标悬停？

现在，我有一扇窗户，看起来像这样：

每个绿色磁盘都代表一个数字。如何使鼠标移动到磁盘上时，出现工具提示或其他内容，并显示数字

当然，这只是一个简单的例子。我们的目标是了解如何在不为每种情况编写大量新代码的情况下实现这一点

目前，我正在画布上绘制一个大的“pict”图像，这似乎是错误的方法。重写它以其他方式工作并没有什么大不了的。我只需要知道正确的方法是什么：哪个工具，哪个库，您打算如何将这些东西组合起来实现鼠标悬停

---

我一直在搜索Racket文档，但到目前为止还没有找到这个问题的明确答案。

您需要使用新方法扩展

canvas%

类。事件上的

方法接收对象，该对象包含与目标窗口相关的鼠标的
x
和
y
坐标

从那里，您可以将其与用于计算在画布上绘制圆的位置的任何数据结构进行比较

因此，类似这样的方法应该有效：

(define clicky-canvas%
  (class canvas%
    (define/override (on-event e)
      (define window-x (send e get-x))
      (define window-y (send e get-y))
      (when (eq? (send e get-event-type) 'left-down)
        .... your code here ....)))

现在，您可以将您的
clicky canvas%
对象插入到先前插入
canvas%
对象的窗口中。
这里尝试向任意标记的图像添加工具提示。它很可能做得既笨拙又不正确。我在这里用它来说明我的困惑。希望您能发布一个答案，展示一种更恰当地使用racket/gui中许多工具的方法。代码中的注释中标记了已知问题，并在下面简要讨论


exp racket/gui上的lang调试
（需要（pict中的前缀：pict）pict/snip mrlib/snip画布）
;; 向windows添加工具提示==========================================
;混淆：这只是因为窗格%不支持客户端->屏幕才需要。
;它不存在的原因也是这个函数不应该存在的原因吗？
（定义（窗口的父窗口）
（let（[父对象（发送窗口获取父对象）]）
（续）
[（非家长）
#f]
[（is-a？父窗口）
家长]
[其他（父窗口父窗口）]）
;混淆：文档是否在客户端->屏幕上或获取当前鼠标状态
;错了吗？
（定义值（屏幕-x-偏移屏幕-y-偏移）
（let值（[（xo yo）（获取显示左上插图）]）
（值（-xo）（-yo）））
（定义（屏幕坐标窗口左上角的窗口）
（let（[父窗口（窗口父窗口）]）
（如果是父母
（let值（[（wx wy）（发送父客户端->屏幕（发送窗口get-x））
（发送窗口get-y））]）
（值（+wx屏幕-x偏移量）（+wy屏幕-y偏移量）））
（值（发送窗口get-x）（发送窗口get-y(()())））
（定义（在窗口？窗口点）；那么，这是否意味着racket/gui不会向画布上的对象发送鼠标事件？对于
canvas%
您是正确的，它不会。对于
editor canvas%
，它会。在这种情况下，您可能需要添加
（事件e上的super）
到你的重写方法。你能看一下我下面的代码吗？它可能比你想看到的代码要多，但希望略读它能更清楚我的错误所在。
#lang debug at-exp racket/gui

(require (prefix-in pict: pict) pict/snip mrlib/snip-canvas)

;; Adding tooltips to windows ==========================================

;CONFUSION: This is needed only because pane% doesn't support client->screen.
;Is the reason why it doesn't also a reason why this function shouldn't exist?
(define (window-parent-of window)
  (let ([parent (send window get-parent)])
    (cond
      [(not parent)
       #f]
      [(is-a? parent window<%>)
       parent]
      [else (window-parent-of parent)])))

;CONFUSION: Is the documentation on client->screen or get-current-mouse-state
;wrong?
(define-values (screen-x-offset screen-y-offset)
  (let-values ([(xo yo) (get-display-left-top-inset)])
    (values (- xo) (- yo))))
(define (window-top-left-in-screen-coordinates window)
  (let ([parent (window-parent-of window)])
    (if parent
      (let-values ([(wx wy) (send parent client->screen (send window get-x)
                                                        (send window get-y))])
        (values (+ wx screen-x-offset) (+ wy screen-y-offset)))
      (values (send window get-x) (send window get-y)))))

(define (in-window? window point)  ; <--- CODE SMELL: reinventing the wheel?
  (define-values (wx wy) (window-top-left-in-screen-coordinates window))
  (define-values (ww wh) (send window get-size))
  (define-values (px py) (values (send point get-x) (send point get-y)))
  (and (<= wx px (+ wx ww))
       (<= wy py (+ wy wh))))

(define (text->tooltip-pict text)
  (let* ([text (if (pair? text) (map ~a text) (string-split (~a text) "\n"))]
         [text-image (for/fold ([text-image (pict:blank)])
                               ([line text])
                       (pict:vl-append text-image (pict:text line)))]
         [text-image (pict:inset text-image 4 2)]
         [background (pict:filled-rectangle
                       (ceiling (pict:pict-width text-image))
                       (ceiling (pict:pict-height text-image))
                       #:color "LemonChiffon"
                       #:draw-border? #t)])
    (pict:cc-superimpose background text-image)))

(define -pict-canvas%  ; <--- CODE SMELL: reinventing the wheel (pict.rkt)
  (class canvas%
    (init-field pict
                [style '()])
    (inherit get-dc)
    (define/override (on-paint)
      (pict:draw-pict pict (get-dc) 0 0))
    (super-new [min-width (exact-ceiling (pict:pict-width pict))]
               [min-height (exact-ceiling (pict:pict-height pict))]
               [stretchable-width #f]
               [stretchable-height #f]
               [style (cons 'transparent style)])))

(define tooltip-window%
  (class frame%
    (init-field text
                point ; will place window above this point
                [pict (text->tooltip-pict text)])
    (define width (exact-ceiling (pict:pict-width pict)))
    (define height (exact-ceiling (pict:pict-height pict)))
    (super-new [style '(no-resize-border no-caption float)]
               [label ""]
               [width width]
               [height height]
               [stretchable-width #f]
               [stretchable-height #f]
               [x (exact-ceiling (- (send point get-x) (/ width 2) 3))]
               [y (exact-ceiling (- (send point get-y) height 8))])
    (define canvas (new -pict-canvas% [pict pict] [parent this]))
    (send this show #t)))

(define TOOLTIP-HOVER-DELAY 600)
  ;When mouse cursor sits motionless over relevant window for this long,
  ;tooltip appears.

(define tooltip-mixin
  (mixin (window<%>) (window<%>)
    (init-field [tooltip (void)]
                [tooltip-window #f])
    (super-new)

    (define (maybe-open-tooltip-window)
      (define-values (point buttons) (get-current-mouse-state))
      (when (and (null? buttons) (in-window? this point))
        (set! tooltip-window (new tooltip-window% [text tooltip]
                                                  [point point]))))

    (define timer
      (new timer% [notify-callback maybe-open-tooltip-window]))

    (define/public (close-tooltip-window)
      (send tooltip-window show #f) ;<--- MEMORY LEAK: Should close, not hide
      (set! tooltip-window #f))

    (define/override (on-subwindow-event receiver e)
      (if (and (not (void? tooltip))
               (eq? this receiver)
               (eq? 'motion (send e get-event-type)))
               ;STRANGE: We never get 'enter or 'leave events
        (begin
          (if tooltip-window
            ; If tooltip is showing, mouse motion closes it
            (close-tooltip-window)
            ; Mouse motion followed by a pause opens it
            (send timer start TOOLTIP-HOVER-DELAY #t))
          #t)  ; UNSURE: What is on-subwindow-event supposed to return here?
        #f))))
      ;BUG: Often no 'motion event comes when the mouse leaves this window,
      ;so the tooltip stays up.

;; Labeled dots with tooltips ==========================================

(define fr (new frame% [label "xtooltip"] [width 200] [height 100]))

(define hp (new horizontal-pane% [parent fr] [alignment '(left top)]))

(define pict-canvas% (tooltip-mixin -pict-canvas%))

(define (disk d)
  (pict:cc-superimpose
    (pict:ghost (pict:disk 50))
    (pict:disk d #:color "aquamarine" #:draw-border? #f)))

(define (make-dot parent label activation)
  (define vp (new vertical-pane% [parent parent]
                                 [stretchable-width #f]
                                 [stretchable-height #f]))
  (define l (new message% [parent vp] [label label]))
  (define d (new pict-canvas% [parent vp]
                              [pict (disk (* 8.0 activation))]
                              [tooltip activation]))
  vp)

(define d1 (make-dot hp "archetype4" 4.1))
(define d2 (make-dot hp "some-sa-node" 2.26))
(define d3 (make-dot hp "this-dot" 0.4))

(send fr show #t)