Racket/GUI中实现图像居中适配的最简方案

我正在开发一款图像处理应用，需要向用户并排展示两张图像，要求无论图像实际尺寸如何，都能适配屏幕并居中显示。目前我通过手动计算并将图像缩放至临时位图实现该功能，但未找到Racket中的简便方法。已知GTK4有内置方案（Gtk.Picture类不适配应用绘制图像，Gtk.Image则可适配），请问Racket中是否有此类内置解决方案？

以下是我当前的代码，核心部分为canvas-original：

#lang racket/gui
(define frame (new frame% [label "Image editor"]))
(define (reset-images bitmap)
  (set! *bmp* bitmap)

  ; schedule redraw
  (send canvas-original refresh))
(define *bmp* (make-object bitmap% 50 50))
(define big-panel (new vertical-panel% [parent frame]))

; Title
(new message% [parent big-panel]
              [label "Title"]
              [font (make-font #:size 30)])
(define image-panel (new horizontal-panel% [parent big-panel] [alignment '(center center)]))
(define canvas-original
  (new canvas%
       [parent image-panel]
       [style '(transparent)]
       [paint-callback
        (lambda (canvas dc)
          (define img-w (send *bmp* get-width))
          (define img-h (send *bmp* get-height))

          (define cw (send canvas get-width))
          (define ch (send canvas get-height))

          ; calculate proper scale between the image and canvas
          (define scale (min (/ cw img-w) (/ ch img-h)))
          
          ;; calculate new scaled dimensions
          (define scaled-w (* img-w scale))
          (define scaled-h (* img-h scale))

          ; this is necessary because the real canvas dc doesn't support draw-bitmap-section-smooth
          (define canvas-size-bmp (send canvas make-bitmap cw ch))
          (define canvas-size-bmp-dc (new bitmap-dc% [bitmap canvas-size-bmp]))

          ;; calculate top-left corner to center the image
          (define x (/ (- cw scaled-w) 2))
          (define y (/ (- ch scaled-h) 2))
          (send canvas-size-bmp-dc draw-bitmap-section-smooth
                *bmp*
                x y scaled-w scaled-h ; dest
                0 0 img-w img-h)      ; src

          (send dc draw-bitmap canvas-size-bmp 0 0))]))

; image upload button
(new button% [parent big-panel]
             [label "加载图像"]
             [callback (lambda (button event)
                         (let ((filename (get-file "加载图像" frame
                                                   #f          #f       #f        null
                                                   ; directory filename extension style
                                                   '(("Images" "*.jp*g;*.png"))))) ; file filter
                           (reset-images (read-bitmap filename))))])

(send frame show #t)

解决方案 #

Racket的GUI库中提供了更简便的实现方式，无需手动计算缩放和创建临时位图，直接使用image%控件结合布局属性即可完成图像的自适应居中：

1. 核心思路：

   • 用image%控件替代canvas%，该控件原生支持按比例缩放图像以适应自身大小。
   • 设置image%的stretchable-width和stretchable-height为#t，允许控件随父容器调整尺寸。
   • 配合父面板的alignment属性，实现图像在容器内的居中显示。

2. 修改后的完整代码：

#lang racket/gui
(define frame (new frame% [label "图像编辑器"]))
(define *img-original* (new image% [bitmap (make-object bitmap% 50 50)]
                                    [stretchable-width #t]
                                    [stretchable-height #t]))

(define big-panel (new vertical-panel% [parent frame]))

; 标题
(new message% [parent big-panel]
              [label "图像编辑器"]
              [font (make-font #:size 30)])
(define image-panel (new horizontal-panel% [parent big-panel]
                                           [alignment '(center center)]
                                           [stretchable-width #t]
                                           [stretchable-height #t]))

; 添加原始图像控件到面板（支持自适应居中）
(send image-panel add-child *img-original*)

; 添加第二张图像控件，实现并排展示
(define *img-processed* (new image% [bitmap (make-object bitmap% 50 50)]
                                     [stretchable-width #t]
                                     [stretchable-height #t]))
(send image-panel add-child *img-processed*)

; 图像上传按钮
(new button% [parent big-panel]
             [label "加载图像"]
             [callback (lambda (button event)
                         (let ((filename (get-file "加载图像" frame
                                                   #f #f #f null
                                                   '(("图像" "*.jp*g;*.png")))))
                           (when filename
                             (define bmp (read-bitmap filename))
                             (send *img-original* set-bitmap bmp)
                             ; 这里可添加处理后图像的设置逻辑
                             (send *img-processed* set-bitmap bmp))))])

(send frame show #t)

3. 关键说明：
   • image%控件会自动保持图像宽高比，缩放时不会变形。
   • 父容器horizontal-panel%设置stretchable-width和stretchable-height为#t，确保面板随窗口大小调整，内部image%控件也能自适应。
   • 加载图像时直接调用set-bitmap方法，控件自动完成缩放和居中，无需手动触发刷新。

内容的提问来源于stack exchange，提问作者blablatruck