win32: fix checkable menu item to toggle on selection

Closes PR 11985
This commit is contained in:
Matthew Flatt 2011-06-17 16:00:30 -06:00
parent f8f289adc0
commit 6f42c6ed5e
3 changed files with 16 additions and 2 deletions

View File

@ -15,7 +15,8 @@
"window.rkt"
"wndclass.rkt"
"hbitmap.rkt"
"cursor.rkt")
"cursor.rkt"
"menu-item.rkt")
(provide
(protect-out frame%
@ -250,7 +251,10 @@
0]
[(and (= msg WM_COMMAND)
(zero? (HIWORD wParam)))
(queue-window-event this (lambda () (on-menu-command (LOWORD wParam))))
(let ([id (LOWORD wParam)])
(let ([item (id-to-menu-item id)])
(when item (send item auto-check)))
(queue-window-event this (lambda () (on-menu-command id))))
0]
[(= msg WM_INITMENU)
(constrained-reply (get-eventspace)

View File

@ -67,6 +67,10 @@
(let ([s (GetMenuState hmenu pos MF_BYPOSITION)])
(not (zero? (bitwise-and s MF_CHECKED)))))
(define/public (auto-check)
(when checkable?
(send parent auto-check id)))
(public [get-id id])
(define (get-id) id)

View File

@ -126,6 +126,12 @@
(lambda (i pos)
(send i get-check hmenu pos))))
(define/public (auto-check id)
(with-item
id
(lambda (i pos)
(send i set-check hmenu pos (not (send i get-check hmenu pos))))))
(define/private (remove-item! pos)
(set! items
(append (take items pos)