63 lines
1.8 KiB
Racket
63 lines
1.8 KiB
Racket
#lang racket/base
|
|
(require racket/class
|
|
(only-in racket/list last)
|
|
ffi/unsafe
|
|
"../../syntax.rkt"
|
|
"../../lock.rkt"
|
|
"../common/queue.rkt"
|
|
"../common/freeze.rkt"
|
|
"../common/dialog.rkt"
|
|
"utils.rkt"
|
|
"const.rkt"
|
|
"types.rkt"
|
|
"window.rkt"
|
|
"frame.rkt"
|
|
"wndclass.rkt")
|
|
|
|
(provide dialog%)
|
|
|
|
(define-cstruct _DLGTEMPLATE
|
|
([style _DWORD]
|
|
[dwExtendedStyle _DWORD]
|
|
[cdit _WORD]
|
|
[x _short]
|
|
[y _short]
|
|
[cx _short]
|
|
[cy _short]
|
|
[menu _short] ; 0
|
|
[class _short] ; 0
|
|
[title _short])) ; 0
|
|
|
|
(define DS_MODALFRAME #x80)
|
|
|
|
(define dialog%
|
|
(class (dialog-mixin frame%)
|
|
(super-new)
|
|
(inherit get-eventspace)
|
|
|
|
(define/override (create-frame parent label x y w h style)
|
|
(let ([hwnd
|
|
(CreateDialogIndirectParamW hInstance
|
|
(make-DLGTEMPLATE
|
|
(bitwise-ior DS_MODALFRAME WS_CAPTION WS_SYSMENU WS_THICKFRAME)
|
|
0 0
|
|
0 0 w h
|
|
0 0 0)
|
|
(and parent (send parent get-hwnd))
|
|
dialog-proc
|
|
0)])
|
|
(SetWindowTextW hwnd label)
|
|
(let ([x (or x 0)]
|
|
[y (or y 0)])
|
|
(MoveWindow hwnd x y w h #t))
|
|
hwnd))
|
|
|
|
(define/override (is-dialog?) #t)
|
|
|
|
(define/override (direct-show on?)
|
|
;; atomic mode
|
|
(when on? (super direct-show on?))
|
|
(for ([f (in-list (get-top-level-windows (get-eventspace)))])
|
|
(send f modal-enable (and (not on?) this)))
|
|
(when (not on?) (super direct-show on?)))))
|