racket/draw: compensate for roundoff in Windows GUI scaling

Roundoff can place a child of a container so that it's position plus
width extend beyond the container's width. For some controls, that
looks especially bad. Approximate precise scaling by having those
control sizes round down, instead of up, while leaving other kinds
of controls alone.

original commit: ed92e271e848513fc0d2e9b54a89d86947fdb465

pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/button.rkt

@@ -133,6 +133,8 @@
         (auto-size font label 60 20 12 0 #:scale-w 1.1 #:scale-h 1.1)]))
     (auto-size-button font label)
 
+    (define/override (size->screen v) (->screen* v))
+
     ;; XP doesn't show both bitmap and string labels,
     ;; so we synthesize a bitmap label when we have both
     (define xp-label-bitmap (and xp? orientation (car label)))

pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/check-box.rkt

@@ -26,6 +26,8 @@
   (define/override (auto-size-button font label)
     (auto-size font label 0 0 20 0))
 
+  (define/override (size->screen v) (->screen v))
+
   (define/public (set-value v)
     (void (SendMessageW (get-hwnd) BM_SETCHECK (if v 1 0) 0)))
 

pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/choice.rkt

@@ -62,6 +62,7 @@
                (lambda (w h)
                  (set-size #f #f w (* h 8))))
 
+    (define/override (size->screen v) (->screen* v))
 
     (define/override (ctlproc w msg wParam lParam default)
       (cond

pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/gauge.rkt

@@ -55,6 +55,8 @@
         (set-size #f #f 100 24)
         (set-size #f #f 24 100))
 
+    (define/override (size->screen v) (->screen* v))
+
     (define/public (get-value)
       (SendMessageW hwnd PBM_GETPOS 0 0))
     (define/public (set-value v)

pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/list-box.rkt

@@ -268,6 +268,8 @@
     (set-control-font font)
     (set-size #f #f 40 60)
 
+    (define/override (size->screen v) (->screen* v))
+
     (define callback cb)
 
     (define/override (is-command? cmd)

pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/slider.rkt

@@ -144,6 +144,8 @@
               (MoveWindow value-hwnd (->screen (quotient (- w value-w) 2)) (->screen (+ dy THICKNESS))
 			  (->screen value-w) (->screen value-h) #t))))))
 
+  (define/override (size->screen v) (->screen* v))
+
   (define/override (control-scrolled)
     (when value-hwnd
       (set-text (get-value)))

pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/utils.rkt

@@ -49,6 +49,7 @@
 	      GetDeviceCaps
 	      strip-&
 	      ->screen
+	      ->screen*
 	      ->normal))
 
 (define gdi32-lib (ffi-lib "gdi32.dll"))
@@ -188,6 +189,11 @@
 	   (if (exact? x)
 	       (ceiling (/ (* x screen-dpi) 96))
 	       (/ (* x screen-dpi) 96)))))
+(define (->screen* x)
+  (if (and (not (= screen-dpi 96))
+	   (exact? x))
+      (floor (/ (* x screen-dpi) 96))
+      (->screen x)))
 
 ;; Convert a screen measure to a normalize (conceptually 96-dpi) measure
 (define (->normal x)

pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/window.rkt

@@ -323,6 +323,13 @@
   (define/public (notify-child-extent x y)
     (void))
 
+  ;; Converting from normalized to screen coordinates
+  ;; with just `->screen` can cause a child's right edge
+  ;; to extend beyond the parent's right edge, due to
+  ;; rounding via `ceiling`. Allow controls that would
+  ;; look bad to round down, instead.
+  (define/public (size->screen v) (->screen v))
+
   (define/public (set-size x y w h)
     (let-values ([(x y w h)
                   (if (or (not x)
@@ -336,7 +343,7 @@
                                 (if (= h -1) (->normal (- (RECT-bottom r) (RECT-top r))) h)))
                       (values x y w h))])
       (when parent (send parent notify-child-extent (+ x w) (+ y h)))
-      (MoveWindow hwnd (->screen x) (->screen y) (->screen w) (->screen h) #t))
+      (MoveWindow hwnd (->screen x) (->screen y) (size->screen w) (size->screen h) #t))
     (unless (and (= w -1) (= h -1))
       (on-resized))
     (queue-on-size)