55 lines
1.5 KiB
Racket
55 lines
1.5 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.ss"
|
|
"const.ss"
|
|
"types.ss"
|
|
"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)
|
|
|
|
(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 (if (= x -11111) 0 x)]
|
|
[y (if (= y -11111) 0 y)])
|
|
(MoveWindow hwnd x y w h #t))
|
|
hwnd))
|
|
|
|
(define/override (is-dialog?) #t)))
|