suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

win32: iconize and refresh problems

Browse Source
This commit is contained in:
Matthew Flatt 2010-10-18 07:31:40 -06:00
parent 970f40c796
commit 3ae3d15d93
6 changed files with 104 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

101
collects/mred/private/wx/win32/frame.rkt
View File

@ -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)

2
collects/mred/private/wx/win32/message.rkt
View File

@ -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

8
collects/mred/private/wx/win32/panel.rkt
View File

@ -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

2
collects/mred/private/wx/win32/radio-box.rkt
View File

@ -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

10
collects/mred/private/wx/win32/window.rkt
View File

@ -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)])

4
collects/mred/private/wx/win32/wndclass.rkt
View File

@ -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")))