diff --git a/collects/mred/private/wx/win32/frame.rkt b/collects/mred/private/wx/win32/frame.rkt index 76c9fc11f4..2b8f1d7dfb 100644 --- a/collects/mred/private/wx/win32/frame.rkt +++ b/collects/mred/private/wx/win32/frame.rkt @@ -81,6 +81,19 @@ WS_EX_TOOLWINDOW WS_EX_TOPMOST)) +(define-cstruct _WINDOWPLACEMENT + ([length _UINT] + [flags _UINT] + [showCmd _UINT] + [ptMinPosition _POINT] + [ptMaxPosition _POINT] + [rcNormalPosition _RECT])) + +(define-user32 GetWindowPlacement (_wfun _HWND _WINDOWPLACEMENT-pointer -> (r : _BOOL) + -> (unless r (failed 'GetWindowPlacement)))) + +(define-user32 IsIconic (_fun _HWND -> _BOOL)) + (defclass frame% window% (init parent label @@ -91,7 +104,6 @@ is-shown? get-eventspace on-size - get-size pre-on-char pre-on-event reset-cursor-in-child) @@ -139,6 +151,17 @@ (define hwnd (get-hwnd)) (SetLayeredWindowAttributes hwnd 0 255 LWA_ALPHA) + ;; record delta between size and client size + ;; for getting the client size when the frame + ;; is iconized: + (define-values (client-dw client-dh) + (let ([w (box 0)] [h (box 0)] + [cw (box 0)] [ch (box 0)]) + (get-size w h) + (get-client-size cw ch) + (values (- (unbox w) (unbox cw)) + (- (unbox h) (unbox ch))))) + (define/public (is-dialog?) #f) (define/override (show on?) @@ -176,13 +199,13 @@ (when (on-close) (direct-show #f)))) 0] - [(= msg WM_SIZE) - (unless (= wParam SIZE_MINIMIZED) - (queue-window-event this (lambda () (on-size 0 0)))) + [(and (= msg WM_SIZE) + (not (= wParam SIZE_MINIMIZED))) + (queue-window-event this (lambda () (on-size 0 0))) (stdret 0 1)] [(= msg WM_MOVE) (queue-window-event this (lambda () (on-size 0 0))) - 0] + (stdret 0 1)] [(= msg WM_ACTIVATE) (let ([state (LOWORD wParam)] [minimized (HIWORD wParam)]) @@ -232,11 +255,6 @@ (define/override (is-enabled-to-root?) #t) - (define/override (get-x) - (RECT-left (GetWindowRect hwnd))) - (define/override (get-y) - (RECT-top (GetWindowRect hwnd))) - (define/public (on-toolbar-click) (void)) (define/public (on-menu-click) (void)) @@ -369,7 +387,67 @@ SW_RESTORE)) (set! hidden-zoomed? (and on? #t)))) - (def/public-unimplemented iconized?) + (define/public (iconized?) + (IsIconic hwnd)) + + (define/public (iconize on?) + (when (is-shown?) + (when (or on? (not (iconized?))) + (ShowWindow hwnd (if on? SW_MINIMIZE SW_RESTORE))))) + + (define/private (get-placement) + (let ([wp (make-WINDOWPLACEMENT + (ctype-sizeof _WINDOWPLACEMENT) + 0 + 0 + (make-POINT 0 0) + (make-POINT 0 0) + (make-RECT 0 0 0 0))]) + (GetWindowPlacement hwnd wp) + wp)) + + (define/override (get-size w h) + (if (iconized?) + (let ([wp (get-placement)]) + (let ([r (WINDOWPLACEMENT-rcNormalPosition wp)]) + (set-box! w (- (RECT-right r) (RECT-left r))) + (set-box! h (- (RECT-bottom r) (RECT-top r))))) + (super get-size w h))) + + (define/override (get-client-size w h) + (if (iconized?) + (begin + (get-size w h) + (set-box! w (max 1 (- (unbox w) client-dw))) + (set-box! h (max 1 (- (unbox h) client-dh)))) + (super get-client-size w h))) + + (define/override (get-x) + (if (iconized?) + (let ([wp (get-placement)]) + (RECT-left (WINDOWPLACEMENT-rcNormalPosition wp))) + (RECT-left (GetWindowRect hwnd)))) + + (define/override (get-y) + (if (iconized?) + (let ([wp (get-placement)]) + (RECT-top (WINDOWPLACEMENT-rcNormalPosition wp))) + (RECT-top (GetWindowRect hwnd)))) + + (define/override (get-width) + (if (iconized?) + (let ([w (box 0)]) + (get-size w (box 0)) + (unbox w)) + (super get-width))) + + (define/override (get-height) + (if (iconized?) + (let ([h (box 0)]) + (get-size (box 0) h) + (unbox h)) + (super get-height))) + (def/public-unimplemented get-menu-bar) (define menu-bar #f) @@ -414,7 +492,6 @@ (set! big-hicon hicon) (SendMessageW hwnd WM_SETICON 1 (cast hicon _HICON _LPARAM)))))) - (def/public-unimplemented iconize) (define/public (set-title s) (atomically (set! saved-title s) diff --git a/collects/mred/private/wx/win32/message.rkt b/collects/mred/private/wx/win32/message.rkt index de6cccdc84..b85f46f8a8 100644 --- a/collects/mred/private/wx/win32/message.rkt +++ b/collects/mred/private/wx/win32/message.rkt @@ -80,7 +80,7 @@ (super-new [callback void] [parent parent] [hwnd - (CreateWindowExW (if (string? label) WS_EX_TRANSPARENT 0) + (CreateWindowExW 0 (get-class) (if (string? label) label diff --git a/collects/mred/private/wx/win32/panel.rkt b/collects/mred/private/wx/win32/panel.rkt index 1ed5ddd6e4..1485ad6f7e 100644 --- a/collects/mred/private/wx/win32/panel.rkt +++ b/collects/mred/private/wx/win32/panel.rkt @@ -75,6 +75,8 @@ (define/public (set-item-cursor x y) (void)))) +(define WS_EX_STATICEDGE #x00020000) + (define panel% (class (panel-mixin window%) (init parent @@ -84,12 +86,14 @@ (super-new [parent parent] [hwnd - (CreateWindowExW 0 + (CreateWindowExW (if (memq 'border style) + WS_EX_STATICEDGE + 0) (if (send parent is-frame?) "PLTPanel" "PLTTabPanel") #f - (bitwise-ior WS_CHILD) + (bitwise-ior WS_CHILD WS_CLIPSIBLINGS) 0 0 w h (send parent get-client-hwnd) #f diff --git a/collects/mred/private/wx/win32/radio-box.rkt b/collects/mred/private/wx/win32/radio-box.rkt index 1036d20648..4509455dd3 100644 --- a/collects/mred/private/wx/win32/radio-box.rkt +++ b/collects/mred/private/wx/win32/radio-box.rkt @@ -58,7 +58,7 @@ [bitmap? (and (label . is-a? . bitmap%) (send label ok?))] [radio-hwnd - (CreateWindowExW WS_EX_TRANSPARENT + (CreateWindowExW 0 "PLTBUTTON" (if (string? label) label diff --git a/collects/mred/private/wx/win32/window.rkt b/collects/mred/private/wx/win32/window.rkt index ab0a742852..e01fba1b8a 100644 --- a/collects/mred/private/wx/win32/window.rkt +++ b/collects/mred/private/wx/win32/window.rkt @@ -269,11 +269,13 @@ (define/public (paint-children) (void)) (define/public (get-x) - (let ([r (GetWindowRect hwnd)]) - (- (RECT-left r) (send parent get-x)))) + (let ([r (GetWindowRect hwnd)] + [pr (GetWindowRect (send parent get-client-hwnd))]) + (- (RECT-left r) (RECT-left pr)))) (define/public (get-y) - (let ([r (GetWindowRect hwnd)]) - (- (RECT-top r) (send parent get-y)))) + (let ([r (GetWindowRect hwnd)] + [pr (GetWindowRect (send parent get-client-hwnd))]) + (- (RECT-top r) (RECT-top pr)))) (define/public (get-width) (let ([r (GetWindowRect hwnd)]) diff --git a/collects/mred/private/wx/win32/wndclass.rkt b/collects/mred/private/wx/win32/wndclass.rkt index ba0b187e93..330f8da676 100644 --- a/collects/mred/private/wx/win32/wndclass.rkt +++ b/collects/mred/private/wx/win32/wndclass.rkt @@ -177,9 +177,7 @@ #f (if controls-are-transparent? #f ; transparent - (let ([p (ptr-add #f (+ COLOR_BTNFACE 1))]) - (cpointer-push-tag! p 'HBRUSH) - p)) + background-hbrush) #f ; menu "PLTTabPanel")))