win32: support MinGW build
A MinGW build is the same shape as a MSVC build (but without MzCOM), unlike a Cygwin build. original commit: 5b016b4c32b3fc4ca5439f98b80d73b10ea8d346
This commit is contained in:
parent
6e2e51aae7
commit
8107903727
|
@ -119,19 +119,21 @@
|
||||||
|
|
||||||
(define wind-proc-ptr (function-ptr wind-proc _WndProc))
|
(define wind-proc-ptr (function-ptr wind-proc _WndProc))
|
||||||
|
|
||||||
|
(define-user32 CallWindowProcW (_wfun _fpointer _HWND _UINT _WPARAM _LPARAM -> _LRESULT))
|
||||||
|
|
||||||
(define (control-proc w msg wParam lParam)
|
(define (control-proc w msg wParam lParam)
|
||||||
(let ([default-ctlproc (hwnd->ctlproc w)])
|
(let ([default-ctlproc (hwnd->ctlproc-fptr w)])
|
||||||
(if (= msg WM_DESTROY)
|
(if (= msg WM_DESTROY)
|
||||||
(begin
|
(begin
|
||||||
(SetWindowLongPtrW w GWLP_WNDPROC (hwnd->ctlproc-fptr w))
|
(SetWindowLongPtrW w GWLP_WNDPROC (hwnd->ctlproc-fptr w))
|
||||||
(unregister-hwnd! w)
|
(unregister-hwnd! w)
|
||||||
(default-ctlproc w msg wParam lParam))
|
(CallWindowProcW default-ctlproc w msg wParam lParam))
|
||||||
(let ([wx (hwnd->wx w)])
|
(let ([wx (hwnd->wx w)])
|
||||||
(if wx
|
(if wx
|
||||||
(send wx ctlproc w msg wParam lParam
|
(send wx ctlproc w msg wParam lParam
|
||||||
(lambda (w msg wParam lParam)
|
(lambda (w msg wParam lParam)
|
||||||
(default-ctlproc w msg wParam lParam)))
|
(CallWindowProcW default-ctlproc w msg wParam lParam)))
|
||||||
(default-ctlproc w msg wParam lParam))))))
|
(CallWindowProcW default-ctlproc w msg wParam lParam))))))
|
||||||
|
|
||||||
(define control_proc (function-ptr control-proc _WndProc))
|
(define control_proc (function-ptr control-proc _WndProc))
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user