suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

win32: fix some test failures

Browse Source
This commit is contained in:
Matthew Flatt 2010-10-31 19:58:48 -06:00
parent e033d9edf1
commit 9fbb7d3a99
2 changed files with 20 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
collects/mred/private/wx/win32/canvas.rkt
View File

@ -318,7 +318,8 @@
(when hscroll? (when hscroll?
(SetScrollInfo canvas-hwnd SB_HORZ (make-info h-len h-page h-pos h-scroll-visible?) #t)) (SetScrollInfo canvas-hwnd SB_HORZ (make-info h-len h-page h-pos h-scroll-visible?) #t))
(when vscroll? (when vscroll?
(SetScrollInfo canvas-hwnd SB_VERT (make-info v-len v-page v-pos v-scroll-visible?) #t))) (SetScrollInfo canvas-hwnd SB_VERT (make-info v-len v-page v-pos v-scroll-visible?) #t))
(void))
(define/override (reset-dc-for-autoscroll) (define/override (reset-dc-for-autoscroll)
(reset-dc) (reset-dc)
@ -336,10 +337,12 @@
(define/public (get-scroll-range which) (define/public (get-scroll-range which)
(if (is-auto-scroll?) (if (is-auto-scroll?)
0 0
(get-real-scroll-range which)))
(define/public (get-real-scroll-range which)
(let ([i (GetScrollInfo canvas-hwnd (if (eq? which 'vertical) SB_VERT SB_HORZ))]) (let ([i (GetScrollInfo canvas-hwnd (if (eq? which 'vertical) SB_VERT SB_HORZ))])
(+ (- (SCROLLINFO-nMax i) (+ (- (SCROLLINFO-nMax i)
(SCROLLINFO-nPage i)) (SCROLLINFO-nPage i))
1)))) 1)))
(define/public (get-scroll-page which) (define/public (get-scroll-page which)
(if (is-auto-scroll?) (if (is-auto-scroll?)
0 0
@ -357,7 +360,8 @@
SIF_DISABLENOSCROLL SIF_DISABLENOSCROLL
0))) 0)))
(set-SCROLLINFO-nMax! i (+ v (SCROLLINFO-nPage i) -1)) (set-SCROLLINFO-nMax! i (+ v (SCROLLINFO-nPage i) -1))
(SetScrollInfo canvas-hwnd (if (eq? which 'vertical) SB_VERT SB_HORZ) i #t))) (SetScrollInfo canvas-hwnd (if (eq? which 'vertical) SB_VERT SB_HORZ) i #t)
(void)))
(define/public (set-scroll-page which v) (define/public (set-scroll-page which v)
(let ([i (GetScrollInfo canvas-hwnd (if (eq? which 'vertical) SB_VERT SB_HORZ))]) (let ([i (GetScrollInfo canvas-hwnd (if (eq? which 'vertical) SB_VERT SB_HORZ))])
(set-SCROLLINFO-fMask! i (bitwise-ior SIF_RANGE SIF_PAGE (set-SCROLLINFO-fMask! i (bitwise-ior SIF_RANGE SIF_PAGE
@ -369,7 +373,8 @@
(set-SCROLLINFO-nMax! i (+ (- (SCROLLINFO-nMax i) (SCROLLINFO-nPage i)) (set-SCROLLINFO-nMax! i (+ (- (SCROLLINFO-nMax i) (SCROLLINFO-nPage i))
v)) v))
(set-SCROLLINFO-nPage! i v) (set-SCROLLINFO-nPage! i v)
(SetScrollInfo canvas-hwnd (if (eq? which 'vertical) SB_VERT SB_HORZ) i #t))) (SetScrollInfo canvas-hwnd (if (eq? which 'vertical) SB_VERT SB_HORZ) i #t)
(void)))
(define/public (on-scroll e) (void)) (define/public (on-scroll e) (void))
(define/private (on-scroll-change dir part) (define/private (on-scroll-change dir part)
@ -446,10 +451,12 @@
(define/public (scroll x y) (define/public (scroll x y)
(when (is-auto-scroll?) (when (is-auto-scroll?)
(when (x . > . 0) (when (x . >= . 0)
(set-scroll-pos 'horizontal (->long (* x (get-scroll-range 'horizontal))))) (set-scroll-pos 'horizontal
(when (y . > . 0) (->long (* x (get-real-scroll-range 'horizontal)))))
(set-scroll-pos 'vertical (->long (* y (get-scroll-range 'vertical))))) (when (y . >= . 0)
(set-scroll-pos 'vertical
(->long (* y (get-real-scroll-range 'vertical)))))
(refresh-for-autoscroll))) (refresh-for-autoscroll)))
(define/public (warp-pointer x y) (void)) (define/public (warp-pointer x y) (void))

4
collects/mred/private/wx/win32/list-box.rkt
View File

@ -184,12 +184,12 @@
(define/public (selected? i) (define/public (selected? i)
(not (zero? (SendMessageW hwnd LB_GETSEL i 0)))) (not (zero? (SendMessageW hwnd LB_GETSEL i 0))))
(define/public (select i [on? #t] [extend? #t]) (define/public (select i [on? #t] [one? #t])
(void (void
(if single? (if single?
(SendMessageW hwnd LB_SETCURSEL (if on? i -1) 0) (SendMessageW hwnd LB_SETCURSEL (if on? i -1) 0)
(begin (begin
(when extend? (unless one?
(SendMessageW hwnd LB_SELITEMRANGE 0 (MAKELPARAM 0 num))) (SendMessageW hwnd LB_SELITEMRANGE 0 (MAKELPARAM 0 num)))
(SendMessageW hwnd LB_SETSEL (if on? 1 0) i))))) (SendMessageW hwnd LB_SETSEL (if on? 1 0) i)))))