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