Author: junrue Date: Wed May 10 22:49:06 2006 New Revision: 125 Modified: trunk/src/tests/uitoolkit/windlg.lisp trunk/src/uitoolkit/system/user32.lisp trunk/src/uitoolkit/widgets/widget.lisp trunk/src/uitoolkit/widgets/window.lisp Log: rewrote compute-outer-size in terms of AdjustWindowRectEx, which bases its calculation on window styles Modified: trunk/src/tests/uitoolkit/windlg.lisp ============================================================================== --- trunk/src/tests/uitoolkit/windlg.lisp (original) +++ trunk/src/tests/uitoolkit/windlg.lisp Wed May 10 22:49:06 2006 @@ -122,7 +122,7 @@ (defmethod gfw:preferred-size ((win dlg-test-panel) width-hint height-hint) (declare (ignore width-hint height-hint)) - (gfs:make-size :width 180 :height 100)) + (gfs:make-size :width 280 :height 200)) (defmethod gfw:event-paint ((self gfw:event-dispatcher) (panel dlg-test-panel) time gc rect) (declare (ignore time rect)) @@ -137,7 +137,7 @@ :layout (make-instance 'gfw:flow-layout :margins 8 :spacing 4 - :style '(:vertical)) + :style '(:horizontal)) :style '(:modal))) (panel (make-instance 'dlg-test-panel :style '(:border) Modified: trunk/src/uitoolkit/system/user32.lisp ============================================================================== --- trunk/src/uitoolkit/system/user32.lisp (original) +++ trunk/src/uitoolkit/system/user32.lisp Wed May 10 22:49:06 2006 @@ -39,6 +39,14 @@ (load-foreign-library "user32.dll") (defcfun + ("AdjustWindowRectEx" adjust-window-rect) + BOOL + (rect LPTR) + (style LONG) + (menu BOOL) + (exstyle LONG)) + +(defcfun ("BeginDeferWindowPos" begin-defer-window-pos) HANDLE (numwin INT)) Modified: trunk/src/uitoolkit/widgets/widget.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget.lisp (original) +++ trunk/src/uitoolkit/widgets/widget.lisp Wed May 10 22:49:06 2006 @@ -86,10 +86,15 @@ (defmethod border-width ((widget widget)) (let* ((hwnd (gfs:handle widget)) (bits (gfs::get-window-long hwnd gfs::+gwl-exstyle+))) - (when (logand bits gfs::+ws-ex-clientedge+) - (return-from border-width (gfs::get-system-metrics gfs::+sm-cxedge+))) - (when (logand bits gfs::+ws-ex-staticedge+) - (return-from border-width (gfs::get-system-metrics gfs::+sm-cxborder+))) + (cond + ((/= (logand bits gfs::+ws-ex-clientedge+) 0) + (return-from border-width (gfs::get-system-metrics gfs::+sm-cxedge+))) + ((/= (logand bits gfs::+ws-ex-dlgmodalframe+) 0) + (return-from border-width (gfs::get-system-metrics gfs::+sm-cxdlgframe+))) + ((/= (logand bits gfs::+ws-ex-staticedge+) 0) + (return-from border-width (gfs::get-system-metrics gfs::+sm-cxborder+))) + ((/= (logand bits gfs::+ws-ex-windowedge+) 0) + (return-from border-width (gfs::get-system-metrics gfs::+sm-cxdlgframe+)))) (setf bits (gfs::get-window-long hwnd gfs::+gwl-style+)) (when (logand bits gfs::+ws-border+) (return-from border-width (gfs::get-system-metrics gfs::+sm-cxborder+))) Modified: trunk/src/uitoolkit/widgets/window.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/window.lisp (original) +++ trunk/src/uitoolkit/widgets/window.lisp Wed May 10 22:49:06 2006 @@ -77,7 +77,6 @@ (child (get-widget tc hwnd)) (parent (get-widget tc (cffi:make-pointer lparam)))) (unless (or (null child) (null parent)) -(format t "~a~%" child) (call-child-visitor-func tc parent child))) 1) @@ -168,17 +167,22 @@ color)) (defmethod compute-outer-size ((win window) desired-client-size) - ;; TODO: consider reimplementing this with AdjustWindowRect - ;; - (let ((client-sz (client-size win)) - (outer-sz (size win)) - (trim-sz (gfs:make-size :width (gfs:size-width desired-client-size) - :height (gfs:size-height desired-client-size)))) - (incf (gfs:size-width trim-sz) (- (gfs:size-width outer-sz) - (gfs:size-width client-sz))) - (incf (gfs:size-height trim-sz) (- (gfs:size-height outer-sz) - (gfs:size-height client-sz))) - trim-sz)) + (let ((hwnd (gfs:handle win)) + (new-size (gfs:make-size))) + (cffi:with-foreign-object (rect-ptr 'gfs::rect) + (cffi:with-foreign-slots ((gfs::left gfs::top gfs::right gfs::bottom) rect-ptr gfs::rect) + (setf gfs::left 0 + gfs::top 0 + gfs::right (gfs:size-width desired-client-size) + gfs::bottom (gfs:size-height desired-client-size)) + (if (zerop (gfs::adjust-window-rect rect-ptr + (gfs::get-window-long hwnd gfs::+gwl-style+) + (if (cffi:null-pointer-p (gfs::get-menu hwnd)) 0 1) + (gfs::get-window-long hwnd gfs::+gwl-exstyle+))) + (error 'gfs:toolkit-error :detail "adjust-window-rect failed")) + (setf (gfs:size-width new-size) (- gfs::right gfs::left) + (gfs:size-height new-size) (- gfs::bottom gfs::top)))) + new-size)) (defmethod enable-layout :before ((win window) flag) (declare (ignore flag))