From e9b6c166a962a4aec506fa69f2e7b2e00229f6ed Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 23 Sep 2014 13:36:55 -0600 Subject: [PATCH] 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 | 2 ++ .../gui-pkgs/gui-lib/mred/private/wx/win32/check-box.rkt | 2 ++ pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/choice.rkt | 1 + pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/gauge.rkt | 2 ++ pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/list-box.rkt | 2 ++ pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/slider.rkt | 2 ++ pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/utils.rkt | 6 ++++++ pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/window.rkt | 9 ++++++++- 8 files changed, 25 insertions(+), 1 deletion(-) diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/button.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/button.rkt index dc753eee..04d56838 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/button.rkt +++ b/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))) diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/check-box.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/check-box.rkt index 3106b450..e4548b7d 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/check-box.rkt +++ b/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))) diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/choice.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/choice.rkt index f3373a5b..568d3eea 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/choice.rkt +++ b/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 diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/gauge.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/gauge.rkt index 09c8e95d..86479fc0 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/gauge.rkt +++ b/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) diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/list-box.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/list-box.rkt index 635e842c..797c41b5 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/list-box.rkt +++ b/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) diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/slider.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/slider.rkt index ef20805c..946c14d4 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/slider.rkt +++ b/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))) diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/utils.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/utils.rkt index ac7efc08..0b176eaf 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/utils.rkt +++ b/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) diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/window.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/window.rkt index 57f1ce18..0982520b 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/window.rkt +++ b/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)