win32 dialogs, etc.
This commit is contained in:
parent
f2bad07fb8
commit
1402583ad2
|
@ -15,6 +15,8 @@
|
|||
(provide base-button%
|
||||
button%)
|
||||
|
||||
(define BM_SETSTYLE #x00F4)
|
||||
|
||||
(define base-button%
|
||||
(class item%
|
||||
(inherit set-control-font auto-size get-hwnd)
|
||||
|
@ -72,7 +74,10 @@
|
|||
[event-type 'button]
|
||||
[time-stamp (current-milliseconds)])))))
|
||||
|
||||
(def/public-unimplemented set-border)))
|
||||
(define/public (set-border on?)
|
||||
(SendMessageW (get-hwnd) BM_SETSTYLE
|
||||
(if on? BS_DEFPUSHBUTTON BS_PUSHBUTTON)
|
||||
1))))
|
||||
|
||||
(define button%
|
||||
(class base-button%
|
||||
|
|
|
@ -79,7 +79,7 @@
|
|||
|
||||
(define hwnd (get-hwnd))
|
||||
|
||||
(define/override (wndproc w msg wParam lParam)
|
||||
(define/override (wndproc w msg wParam lParam default)
|
||||
(cond
|
||||
[(= msg WM_PAINT)
|
||||
(let* ([ps (malloc 128)]
|
||||
|
@ -96,7 +96,7 @@
|
|||
[(= msg WM_VSCROLL)
|
||||
(on-scroll-change SB_VERT (LOWORD wParam))
|
||||
0]
|
||||
[else (super wndproc w msg wParam lParam)]))
|
||||
[else (super wndproc w msg wParam lParam default)]))
|
||||
|
||||
(define dc (new dc% [canvas this]))
|
||||
(send dc start-backing-retained)
|
||||
|
|
|
@ -403,6 +403,7 @@
|
|||
(define CW_USEDEFAULT #x80000000)
|
||||
|
||||
(define WS_EX_LAYERED #x00080000)
|
||||
(define WS_EX_TRANSPARENT #x00000020)
|
||||
|
||||
(define LWA_ALPHA #x00000002)
|
||||
|
||||
|
|
|
@ -1,14 +1,92 @@
|
|||
#lang scheme/base
|
||||
(require scheme/class
|
||||
"../../syntax.rkt"
|
||||
"window.rkt")
|
||||
#lang racket/base
|
||||
(require racket/class
|
||||
(only-in racket/list last)
|
||||
ffi/unsafe
|
||||
"../../syntax.rkt"
|
||||
"../../lock.rkt"
|
||||
"../common/queue.rkt"
|
||||
"../common/freeze.rkt"
|
||||
"utils.ss"
|
||||
"const.ss"
|
||||
"types.ss"
|
||||
"window.rkt"
|
||||
"frame.rkt"
|
||||
"wndclass.rkt")
|
||||
|
||||
(provide dialog%)
|
||||
|
||||
(defclass dialog% window%
|
||||
(def/public-unimplemented system-menu)
|
||||
(def/public-unimplemented set-title)
|
||||
(def/public-unimplemented enforce-size)
|
||||
(def/public-unimplemented on-close)
|
||||
(def/public-unimplemented on-activate)
|
||||
(super-new))
|
||||
(define _WORD _short)
|
||||
|
||||
(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 _INT_PTR _long)
|
||||
(define _DialogProc (_wfun _HWND _UINT _WPARAM _LPARAM -> _INT_PTR))
|
||||
|
||||
|
||||
(define DS_MODALFRAME #x80)
|
||||
|
||||
(define-user32 CreateDialogIndirectParamW (_wfun _HINSTANCE
|
||||
_DLGTEMPLATE-pointer
|
||||
_HWND
|
||||
_fpointer
|
||||
-> _HWND))
|
||||
|
||||
(define (dlgproc w msg wParam lParam)
|
||||
(let ([wx (hwnd->wx w)])
|
||||
(if wx
|
||||
(send wx wndproc w msg wParam lParam
|
||||
(lambda (w msg wParam lParam) 0))
|
||||
0)))
|
||||
|
||||
(define dialog-proc (function-ptr dlgproc _DialogProc))
|
||||
|
||||
(define dialog-level-counter 0)
|
||||
|
||||
(define dialog%
|
||||
(class frame%
|
||||
(super-new)
|
||||
|
||||
(define/override (create-frame parent label w h)
|
||||
(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)])
|
||||
(SetWindowTextW hwnd label)
|
||||
(MoveWindow hwnd 0 0 w h #t)
|
||||
hwnd))
|
||||
|
||||
(define/override (is-dialog?) #t)
|
||||
|
||||
(define dialog-level 0)
|
||||
(define/override (get-dialog-level) dialog-level)
|
||||
|
||||
(define/override (frame-relative-dialog-status win)
|
||||
(let ([dl (send win get-dialog-level)])
|
||||
(cond
|
||||
[(= dl dialog-level) 'same]
|
||||
[(dl . > . dialog-level) #f]
|
||||
[else 'other])))
|
||||
|
||||
(define/override (direct-show on?)
|
||||
(when on?
|
||||
(set! dialog-level-counter (add1 dialog-level-counter))
|
||||
(set! dialog-level dialog-level-counter))
|
||||
(unless on?
|
||||
(set! dialog-level 0))
|
||||
(super direct-show on?))))
|
||||
|
||||
|
|
|
@ -6,9 +6,10 @@
|
|||
"../../lock.rkt"
|
||||
"../common/queue.rkt"
|
||||
"../common/freeze.rkt"
|
||||
"utils.ss"
|
||||
"const.ss"
|
||||
"types.ss"
|
||||
"utils.rkt"
|
||||
"const.rkt"
|
||||
"types.rkt"
|
||||
"theme.rkt"
|
||||
"window.rkt"
|
||||
"wndclass.rkt")
|
||||
|
||||
|
@ -30,17 +31,19 @@
|
|||
on-size
|
||||
pre-on-char pre-on-event)
|
||||
|
||||
(define/public (create-frame parent label w h)
|
||||
(CreateWindowExW (bitwise-ior WS_EX_LAYERED)
|
||||
"PLTFrame"
|
||||
(if label label "")
|
||||
WS_OVERLAPPEDWINDOW
|
||||
0 0 w h
|
||||
#f
|
||||
#f
|
||||
hInstance
|
||||
#f))
|
||||
|
||||
(super-new [parent #f]
|
||||
[hwnd
|
||||
(CreateWindowExW 0 ; (bitwise-ior WS_EX_LAYERED)
|
||||
"PLTFrame"
|
||||
(if label label "")
|
||||
WS_OVERLAPPEDWINDOW
|
||||
0 0 w h
|
||||
#f
|
||||
#f
|
||||
hInstance
|
||||
#f)]
|
||||
[hwnd (create-frame parent label w h)]
|
||||
[style (cons 'invisible style)])
|
||||
|
||||
(define hwnd (get-hwnd))
|
||||
|
@ -67,7 +70,7 @@
|
|||
(define/private (stdret f d)
|
||||
(if (is-dialog?) d f))
|
||||
|
||||
(define/override (wndproc w msg wParam lParam)
|
||||
(define/override (wndproc w msg wParam lParam default)
|
||||
(cond
|
||||
[(= msg WM_CLOSE)
|
||||
(queue-window-event this (lambda ()
|
||||
|
@ -99,7 +102,7 @@
|
|||
(lambda () (on-menu-click))
|
||||
(void))
|
||||
0]
|
||||
[else (super wndproc w msg wParam lParam)]))
|
||||
[else (super wndproc w msg wParam lParam default)]))
|
||||
|
||||
(define/public (on-close) (void))
|
||||
|
||||
|
@ -147,15 +150,10 @@
|
|||
(define/override (call-pre-on-char w e)
|
||||
(pre-on-char w e))
|
||||
|
||||
(define dialog-level 0)
|
||||
(define/override (get-dialog-level) 0)
|
||||
|
||||
(define/public (frame-relative-dialog-status win)
|
||||
(cond
|
||||
[(is-dialog?) (let ([dl (send win get-dialog-level)])
|
||||
(cond
|
||||
[(= dl dialog-level) 'same]
|
||||
[(dl . > . dialog-level) #f]
|
||||
[else 'other]))]
|
||||
[else #f]))
|
||||
#f)
|
||||
|
||||
(def/public-unimplemented designate-root-frame)
|
||||
(def/public-unimplemented system-menu)
|
||||
|
@ -170,6 +168,8 @@
|
|||
(atomically
|
||||
(set! menu-bar mb)
|
||||
(send mb set-parent this)))
|
||||
|
||||
(define/override (is-frame?) #t)
|
||||
|
||||
(def/public-unimplemented set-icon)
|
||||
(def/public-unimplemented iconize)
|
||||
|
|
|
@ -36,7 +36,7 @@
|
|||
|
||||
(define client-hwnd
|
||||
(CreateWindowExW 0
|
||||
"PLTPanel"
|
||||
"PLTTabPanel"
|
||||
#f
|
||||
(bitwise-ior WS_CHILD WS_VISIBLE)
|
||||
0 0 w h
|
||||
|
@ -53,7 +53,7 @@
|
|||
client-hwnd)
|
||||
|
||||
(define label-h 0)
|
||||
|
||||
|
||||
(set-control-font #f)
|
||||
(auto-size label 0 0 0 0
|
||||
(lambda (w h)
|
||||
|
|
|
@ -35,7 +35,7 @@
|
|||
|
||||
(super-new [parent parent]
|
||||
[hwnd
|
||||
(CreateWindowExW 0
|
||||
(CreateWindowExW (if (string? label) WS_EX_TRANSPARENT 0)
|
||||
(get-class)
|
||||
(if (string? label)
|
||||
label
|
||||
|
|
|
@ -30,7 +30,9 @@
|
|||
(super-new [parent parent]
|
||||
[hwnd
|
||||
(CreateWindowExW 0
|
||||
"PLTPanel"
|
||||
(if (send parent is-frame?)
|
||||
"PLTPanel"
|
||||
"PLTTabPanel")
|
||||
#f
|
||||
(bitwise-ior WS_CHILD)
|
||||
0 0 w h
|
||||
|
|
|
@ -34,7 +34,7 @@
|
|||
|
||||
(define hwnd
|
||||
(CreateWindowExW 0
|
||||
"PLTPanel"
|
||||
"PLTTabPanel"
|
||||
#f
|
||||
(bitwise-ior WS_CHILD)
|
||||
0 0 w h
|
||||
|
@ -53,7 +53,8 @@
|
|||
[bitmap? (and (label . is-a? . bitmap%)
|
||||
(send label ok?))]
|
||||
[radio-hwnd
|
||||
(CreateWindowExW 0 "BUTTON"
|
||||
(CreateWindowExW WS_EX_TRANSPARENT
|
||||
"BUTTON"
|
||||
(if (string? label)
|
||||
label
|
||||
"<image>")
|
||||
|
|
|
@ -1,9 +1,100 @@
|
|||
#lang scheme/base
|
||||
(require scheme/class
|
||||
"../../syntax.rkt"
|
||||
"window.rkt")
|
||||
#lang racket/base
|
||||
(require racket/class
|
||||
ffi/unsafe
|
||||
"../../syntax.rkt"
|
||||
"../../lock.rkt"
|
||||
"../common/event.rkt"
|
||||
"item.rkt"
|
||||
"utils.rkt"
|
||||
"const.rkt"
|
||||
"window.rkt"
|
||||
"panel.rkt"
|
||||
"wndclass.rkt"
|
||||
"types.rkt")
|
||||
|
||||
(provide tab-panel%)
|
||||
|
||||
(defclass tab-panel% window%
|
||||
(super-new))
|
||||
(define TCIF_TEXT #x0001)
|
||||
(define TCM_SETUNICODEFORMAT #x2005)
|
||||
(define TCM_FIRST #x1300)
|
||||
(define TCM_INSERTITEMW (+ TCM_FIRST 62))
|
||||
|
||||
(define-cstruct _TCITEMW
|
||||
([mask _UINT]
|
||||
[dwState _DWORD]
|
||||
[dwStateMask _DWORD]
|
||||
[pszText _permanent-string/utf-16]
|
||||
[cchTextMax _int]
|
||||
[iImage _int]
|
||||
[lParam _LPARAM]))
|
||||
|
||||
(define tab-panel%
|
||||
(class (panel-mixin window%)
|
||||
(init parent
|
||||
x y w h
|
||||
style
|
||||
choices)
|
||||
|
||||
(define callback void)
|
||||
|
||||
(inherit auto-size set-control-font)
|
||||
|
||||
(define hwnd
|
||||
(CreateWindowExW 0
|
||||
"SysTabControl32"
|
||||
""
|
||||
(bitwise-ior WS_CHILD WS_CLIPSIBLINGS)
|
||||
0 0 0 0
|
||||
(send parent get-client-hwnd)
|
||||
#f
|
||||
hInstance
|
||||
#f))
|
||||
|
||||
(define client-hwnd
|
||||
(CreateWindowExW 0
|
||||
"PLTTabPanel"
|
||||
#f
|
||||
(bitwise-ior WS_CHILD WS_VISIBLE)
|
||||
0 0 w h
|
||||
hwnd
|
||||
#f
|
||||
hInstance
|
||||
#f))
|
||||
|
||||
(super-new [parent parent]
|
||||
[hwnd hwnd]
|
||||
[style style])
|
||||
|
||||
(define/override (get-client-hwnd)
|
||||
client-hwnd)
|
||||
|
||||
(SendMessageW hwnd TCM_SETUNICODEFORMAT 1 0)
|
||||
|
||||
(atomically
|
||||
(let ([item (cast (malloc _TCITEMW 'raw) _pointer _TCITEMW-pointer)])
|
||||
(set-TCITEMW-mask! item TCIF_TEXT)
|
||||
(for ([i (in-list choices)]
|
||||
[pos (in-naturals)])
|
||||
(set-TCITEMW-pszText! item i)
|
||||
(SendMessageW hwnd TCM_INSERTITEMW pos (cast item _pointer _LPARAM))
|
||||
(free (TCITEMW-pszText item)))
|
||||
(free item)))
|
||||
|
||||
(define tab-height 0)
|
||||
|
||||
(set-control-font #f)
|
||||
(auto-size choices 0 0 0 0 #:combine-width +
|
||||
(lambda (w h)
|
||||
(set! tab-height (+ h 6))
|
||||
(set-size -11111 -11111
|
||||
(+ w (* 6 (length choices)))
|
||||
(+ h 12))))
|
||||
|
||||
(define/override (set-size x y w h)
|
||||
(super set-size x y w h)
|
||||
(unless (or (= w -1) (= h -1))
|
||||
(MoveWindow client-hwnd 1 (+ tab-height 2) (- w 4) (- h tab-height 6) #t)))
|
||||
|
||||
(define/public (set-callback cb)
|
||||
(set! callback cb))))
|
||||
|
||||
|
|
|
@ -7,7 +7,9 @@
|
|||
(provide get-theme-logfont
|
||||
get-theme-font-face
|
||||
get-theme-font-size
|
||||
_LOGFONT-pointer)
|
||||
_LOGFONT-pointer
|
||||
DrawThemeParentBackground
|
||||
EnableThemeDialogTexture)
|
||||
|
||||
(define _HTHEME (_cpointer 'HTHEME))
|
||||
|
||||
|
@ -59,6 +61,14 @@
|
|||
(error 'GetThemeSysFont "failed: ~s" (bitwise-and #xFFFF r))
|
||||
f)))
|
||||
|
||||
(define-uxtheme DrawThemeParentBackground (_wfun _HWND _HDC _pointer -> (r : _HRESULT)
|
||||
-> (when (negative? r)
|
||||
(error 'DrawThemeParentBackground "failed: ~s" (bitwise-and #xFFFF r)))))
|
||||
|
||||
(define-uxtheme EnableThemeDialogTexture (_wfun _HWND _DWORD -> (r : _HRESULT)
|
||||
-> (when (negative? r)
|
||||
(error 'EnableThemeDialogTexture "failed: ~s" (bitwise-and #xFFFF r)))))
|
||||
|
||||
(define BP_PUSHBUTTON 1)
|
||||
(define PBS_NORMAL 1)
|
||||
(define TMT_FONT 210)
|
||||
|
|
|
@ -83,9 +83,7 @@
|
|||
(let ([c (malloc len _uint16 'raw)])
|
||||
(memcpy c p len _uint16)
|
||||
c))))))
|
||||
(lambda (p)
|
||||
(and p
|
||||
(cast p _pointer _string/utf-16)))))
|
||||
(lambda (p) p)))
|
||||
|
||||
(define _LONG _long)
|
||||
(define _SHORT _short)
|
||||
|
|
|
@ -22,6 +22,9 @@
|
|||
|
||||
(define (unhide-cursor) (void))
|
||||
|
||||
(define WM_PRINT #x0317)
|
||||
(define WM_PRINTCLIENT #x0318)
|
||||
|
||||
(define-user32 CreateWindowExW (_wfun _DWORD
|
||||
_string/utf-16
|
||||
_string/utf-16
|
||||
|
@ -35,6 +38,8 @@
|
|||
(if r rect (failed 'GetClientRect))))
|
||||
|
||||
(define-gdi32 CreateFontIndirectW (_wfun _LOGFONT-pointer -> _HFONT))
|
||||
(define-user32 FillRect (_wfun _HDC _RECT-pointer _HBRUSH -> (r : _int)
|
||||
-> (when (zero? r) (failed 'FillRect))))
|
||||
|
||||
(define-cstruct _NMHDR
|
||||
([hwndFrom _HWND]
|
||||
|
@ -51,6 +56,25 @@
|
|||
(values (* 1/4 (bitwise-and v #xFFFF))
|
||||
(* 1/8 (arithmetic-shift v -16)))))
|
||||
|
||||
(define-cstruct _LOGBRUSH
|
||||
([lbStyle _UINT]
|
||||
[lbColor _COLORREF]
|
||||
[lbHatch _pointer]))
|
||||
|
||||
(define BS_NULL 1)
|
||||
(define transparent-logbrush (make-LOGBRUSH BS_NULL 0 #f))
|
||||
|
||||
(define-gdi32 CreateBrushIndirect (_wfun _LOGBRUSH-pointer -> _HBRUSH))
|
||||
|
||||
(define TRANSPARENT 1)
|
||||
(define-gdi32 SetBkMode (_wfun _HDC _int -> (r : _int)
|
||||
-> (when (zero? r) (failed 'SetBkMode))))
|
||||
|
||||
(define-user32 BeginPaint (_wfun _HWND _pointer -> _HDC))
|
||||
(define-user32 EndPaint (_wfun _HDC _pointer -> _BOOL))
|
||||
(define-user32 InvalidateRect (_wfun _HWND (_or-null _RECT-pointer) _BOOL -> (r : _BOOL)
|
||||
-> (unless r (failed 'InvalidateRect))))
|
||||
|
||||
(defclass window% object%
|
||||
(init-field parent hwnd)
|
||||
(init style
|
||||
|
@ -71,7 +95,7 @@
|
|||
(define/public (is-hwnd? a-hwnd)
|
||||
(ptr-equal? hwnd a-hwnd))
|
||||
|
||||
(define/public (wndproc w msg wParam lParam)
|
||||
(define/public (wndproc w msg wParam lParam default)
|
||||
(cond
|
||||
[(= msg WM_SETFOCUS)
|
||||
(queue-window-event this (lambda () (on-set-focus)))
|
||||
|
@ -83,7 +107,7 @@
|
|||
(when (or (= wParam VK_MENU) (= wParam VK_F4)) ;; F4 is close
|
||||
(unhide-cursor)
|
||||
(begin0
|
||||
(DefWindowProcW w msg wParam lParam)
|
||||
(default w msg wParam lParam)
|
||||
(do-key wParam lParam #f #f)))]
|
||||
[(= msg WM_KEYDOWN)
|
||||
(do-key wParam lParam #f #f)
|
||||
|
@ -95,7 +119,7 @@
|
|||
(when (= wParam VK_MENU)
|
||||
(unhide-cursor)
|
||||
(begin0
|
||||
(DefWindowProcW w msg wParam lParam)
|
||||
(default w msg wParam lParam)
|
||||
(do-key wParam lParam #t #f)))]
|
||||
[(= msg WM_CHAR)
|
||||
(do-key wParam lParam #t #f)
|
||||
|
@ -107,7 +131,7 @@
|
|||
(begin
|
||||
(send wx do-command control-hwnd)
|
||||
0)
|
||||
(DefWindowProcW w msg wParam lParam)))]
|
||||
(default w msg wParam lParam)))]
|
||||
[(= msg WM_NOTIFY)
|
||||
#;
|
||||
(let* ([nmhdr (cast lParam _LPARAM _NMHDR-pointer)]
|
||||
|
@ -123,9 +147,9 @@
|
|||
(begin
|
||||
(send wx control-scrolled)
|
||||
0)
|
||||
(DefWindowProcW w msg wParam lParam)))]
|
||||
(default w msg wParam lParam)))]
|
||||
[else
|
||||
(DefWindowProcW w msg wParam lParam)]))
|
||||
(default w msg wParam lParam)]))
|
||||
|
||||
(define/public (is-command? cmd) #f)
|
||||
(define/public (control-scrolled) #f)
|
||||
|
@ -208,7 +232,9 @@
|
|||
|
||||
(define/public (auto-size label min-w min-h dw dh
|
||||
[resize
|
||||
(lambda (w h) (set-size -11111 -11111 w h))])
|
||||
(lambda (w h) (set-size -11111 -11111 w h))]
|
||||
#:combine-width [combine-w max]
|
||||
#:combine-height [combine-h max])
|
||||
(unless measure-dc
|
||||
(let* ([bm (make-object bitmap% 1 1)]
|
||||
[dc (make-object bitmap-dc% bm)]
|
||||
|
@ -228,8 +254,8 @@
|
|||
(loop (car label))]
|
||||
[(w2 h2 d2 a2)
|
||||
(loop (cdr label))])
|
||||
(values (max w1 w2) (max h1 h2)
|
||||
(max d1 d1) (max a1 a2)))]
|
||||
(values (combine-w w1 w2) (combine-h h1 h2)
|
||||
(combine-h d1 d1) (combine-h a1 a2)))]
|
||||
[else
|
||||
(send measure-dc get-text-extent label #f #t)]))]
|
||||
[(->int) (lambda (v) (inexact->exact (floor v)))])
|
||||
|
@ -240,6 +266,7 @@
|
|||
(def/public-unimplemented center)
|
||||
|
||||
(define/public (get-parent) parent)
|
||||
(define/public (is-frame?) #f)
|
||||
|
||||
(define/public (refresh) (void))
|
||||
(define/public (on-resized) (void))
|
||||
|
@ -337,7 +364,9 @@
|
|||
;; re-sync the display in case a stream of
|
||||
;; events (e.g., key repeat) have a corresponding
|
||||
;; stream of screen updates.
|
||||
(void)))
|
||||
(void))
|
||||
|
||||
(define/public (get-dialog-level) (send parent get-dialog-level)))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
|
|
|
@ -74,6 +74,9 @@
|
|||
(define-user32 LoadCursorW (_wfun _HINSTANCE _pointer -> _HCURSOR))
|
||||
(define-user32 LoadIconW (_wfun _HINSTANCE _pointer -> _HICON))
|
||||
|
||||
(define-user32 GetClassInfoW (_wfun _HINSTANCE _string/utf-16 (i : (_ptr o _WNDCLASS)) -> (r : _BOOL)
|
||||
-> (if r i (failed 'GetClassInfoW))))
|
||||
|
||||
(define-user32 DefWindowProcW (_wfun _HWND _UINT _WPARAM _LPARAM -> _LRESULT))
|
||||
|
||||
#;(define-user32 PostQuitMessage (_wfun _int -> _void))
|
||||
|
@ -81,7 +84,7 @@
|
|||
(define (wind-proc w msg wparam lparam)
|
||||
(let ([wx (hwnd->wx w)])
|
||||
(if wx
|
||||
(send wx wndproc w msg wparam lparam)
|
||||
(send wx wndproc w msg wparam lparam DefWindowProcW)
|
||||
(DefWindowProcW w msg wparam lparam))))
|
||||
|
||||
(define hInstance (GetModuleHandleW #f))
|
||||
|
@ -125,4 +128,21 @@
|
|||
#f ; menu
|
||||
"PLTPanel")))
|
||||
|
||||
(define controls-are-transparent? #f)
|
||||
|
||||
(void (RegisterClassW (make-WNDCLASS 0
|
||||
wind-proc
|
||||
0
|
||||
0
|
||||
hInstance
|
||||
#f
|
||||
(LoadCursorW #f IDC_ARROW)
|
||||
(if controls-are-transparent?
|
||||
#f ; transparent
|
||||
(let ([p (ptr-add #f (+ COLOR_BTNFACE 1))])
|
||||
(cpointer-push-tag! p 'HBRUSH)
|
||||
p))
|
||||
#f ; menu
|
||||
"PLTTabPanel")))
|
||||
|
||||
(define-user32 MessageBoxW (_fun _HWND _string/utf-16 _string/utf-16 _UINT -> _int))
|
||||
|
|
|
@ -1,5 +1,3 @@
|
|||
//Microsoft Developer Studio generated resource script.
|
||||
//
|
||||
|
||||
/////////////////////////////////////////////////////////////////////////////
|
||||
//
|
||||
|
|
Loading…
Reference in New Issue
Block a user