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

win32: fix horizontal `radio-box%'

Browse Source 
Merge to 5.1
(cherry picked from commit 8f404a4618)
This commit is contained in:
Matthew Flatt 2011-02-04 09:19:19 -07:00 committed by Ryan Culpepper
parent 9721ad1ce7
commit 08ff71d1a1
1 changed files with 41 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

77
collects/mred/private/wx/win32/radio-box.rkt
View File

@ -49,42 +49,47 @@
(define label-bitmaps null) (define label-bitmaps null)
(define radio-hwnds (define radio-hwnds
(let loop ([y 0] [w 0] [labels labels]) (let ([horiz? (memq 'horizontal style)])
(if (null? labels) (let loop ([y 0] [w 0] [labels labels])
(begin (if (null? labels)
(MoveWindow hwnd 0 0 w y #t) (begin
null) (MoveWindow hwnd 0 0 w y #t)
(let* ([label (car labels)] null)
[bitmap? (label . is-a? . bitmap%)] (let* ([label (car labels)]
[radio-hwnd [bitmap? (label . is-a? . bitmap%)]
(CreateWindowExW/control 0 [radio-hwnd
"PLTBUTTON" (CreateWindowExW/control 0
(if (string? label) "PLTBUTTON"
label (if (string? label)
"<image>") label
(bitwise-ior BS_RADIOBUTTON WS_CHILD WS_CLIPSIBLINGS "<image>")
(if bitmap? (bitwise-ior BS_RADIOBUTTON WS_CHILD WS_CLIPSIBLINGS
BS_BITMAP (if bitmap?
0)) BS_BITMAP
0 0 0 0 0))
hwnd 0 0 0 0
#f hwnd
hInstance #f
#f)]) hInstance
(when bitmap? #f)])
(let ([hbitmap (bitmap->hbitmap label)]) (when bitmap?
(set! label-bitmaps (cons hbitmap label-bitmaps)) (let ([hbitmap (bitmap->hbitmap label)])
(SendMessageW radio-hwnd BM_SETIMAGE IMAGE_BITMAP (set! label-bitmaps (cons hbitmap label-bitmaps))
(cast hbitmap _HBITMAP _LPARAM)))) (SendMessageW radio-hwnd BM_SETIMAGE IMAGE_BITMAP
(ShowWindow radio-hwnd SW_SHOW) (cast hbitmap _HBITMAP _LPARAM))))
(set-control-font font radio-hwnd) (ShowWindow radio-hwnd SW_SHOW)
(let-values ([(w1 h) (set-control-font font radio-hwnd)
(auto-size font label 0 0 20 4 (let-values ([(w1 h)
(lambda (w h) (auto-size font label 0 0 20 4
(MoveWindow radio-hwnd 0 (+ y SEP) w h #t) (lambda (w1 h1)
(values w h)))]) (if horiz?
(cons radio-hwnd (MoveWindow radio-hwnd (+ w SEP) 0 w1 h1 #t)
(loop (+ y SEP h) (max w1 w) (cdr labels)))))))) (MoveWindow radio-hwnd 0 (+ y SEP) w1 h1 #t))
(values w1 h1)))])
(cons radio-hwnd
(loop (if horiz? (max y h) (+ y SEP h))
(if horiz? (+ w SEP w1) (max w1 w))
(cdr labels)))))))))
(unless (= val -1) (unless (= val -1)
(SendMessageW (list-ref radio-hwnds val) BM_SETCHECK 1 0)) (SendMessageW (list-ref radio-hwnds val) BM_SETCHECK 1 0))