win32: fix checkable menu item to toggle on selection
Closes PR 11985
This commit is contained in:
parent
f8f289adc0
commit
6f42c6ed5e
|
@ -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)
|
||||
|
|
|
@ -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)
|
||||
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in New Issue
Block a user