Author: junrue Date: Mon Sep 11 16:30:56 2006 New Revision: 257 Modified: trunk/docs/manual/event-functions.texinfo trunk/src/uitoolkit/graphics/graphics-context.lisp trunk/src/uitoolkit/system/system-utils.lisp trunk/src/uitoolkit/widgets/window.lisp Log: account for menu wrapping in window compute-outer-size Modified: trunk/docs/manual/event-functions.texinfo ============================================================================== --- trunk/docs/manual/event-functions.texinfo (original) +++ trunk/docs/manual/event-functions.texinfo Mon Sep 11 16:30:56 2006 @@ -239,10 +239,10 @@ @event-dispatcher-arg @item widget The @ref{widget} whose contents need to be repainted. -@item gc +@item graphics-context A @ref{graphics-context} initialized for use during this paint event and which will be @ref{dispose}d after this method returns. -@item rect +@item rectangle The specific @ref{rectangle} within @var{widget} needing to be repainted. @end table @end deffn Modified: trunk/src/uitoolkit/graphics/graphics-context.lisp ============================================================================== --- trunk/src/uitoolkit/graphics/graphics-context.lisp (original) +++ trunk/src/uitoolkit/graphics/graphics-context.lisp Mon Sep 11 16:30:56 2006 @@ -175,8 +175,8 @@ (setf gfs::tablength tab-width) (setf gfs::leftmargin 0) (setf gfs::rightmargin 0) - (gfs::with-rect - (gfs::draw-text-ex hdc str -1 gfs::rect-ptr (logior dt-flags gfs::+dt-calcrect+) dt-ptr) + (gfs::with-rect (rect-ptr) + (gfs::draw-text-ex hdc str -1 rect-ptr (logior dt-flags gfs::+dt-calcrect+) dt-ptr) (setf (gfs:size-width sz) (- gfs::right gfs::left)) (setf (gfs:size-height sz) (- gfs::bottom gfs::top)))))) (when (or (zerop len) (zerop (gfs:size-height sz))) @@ -292,7 +292,7 @@ (let ((hdc (gfs:handle self)) (pnt (gfs:location rect)) (size (gfs:size rect))) - (gfs::with-rect + (gfs::with-rect (rect-ptr) (setf gfs::top (gfs:point-y pnt) gfs::left (gfs:point-x pnt) gfs::bottom (+ (gfs:point-y pnt) (gfs:size-height size)) @@ -441,19 +441,19 @@ (setf gfs::tablength tb-width) (setf gfs::leftmargin 0) (setf gfs::rightmargin 0) - (gfs::with-rect + (gfs::with-rect (rect-ptr) (setf gfs::left (gfs:point-x pnt)) (setf gfs::top (gfs:point-y pnt)) (gfs::draw-text-ex (gfs:handle self) text -1 - gfs::rect-ptr + rect-ptr (logior gfs::+dt-calcrect+ (logand flags (lognot gfs::+dt-vcenter+))) dt-ptr) (gfs::draw-text-ex (gfs:handle self) text (length text) - gfs::rect-ptr + rect-ptr flags dt-ptr) (gfs::set-bk-mode (gfs:handle self) old-bk-mode)))))) Modified: trunk/src/uitoolkit/system/system-utils.lisp ============================================================================== --- trunk/src/uitoolkit/system/system-utils.lisp (original) +++ trunk/src/uitoolkit/system/system-utils.lisp Mon Sep 11 16:30:56 2006 @@ -132,11 +132,11 @@ ;;; convenience macros ;;; -(defmacro with-rect (&body body) - `(cffi:with-foreign-object (rect-ptr 'gfs::rect) +(defmacro with-rect ((rect-var) &body body) + `(cffi:with-foreign-object (,rect-var 'gfs::rect) (cffi:with-foreign-slots ((gfs::left gfs::right gfs::top gfs::bottom) - rect-ptr gfs::rect) - (zero-mem rect-ptr gfs::rect) + ,rect-var gfs::rect) + (zero-mem ,rect-var gfs::rect) ,@body))) (defmacro with-hfont-selected ((hdc hfont) &body body) Modified: trunk/src/uitoolkit/widgets/window.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/window.lisp (original) +++ trunk/src/uitoolkit/widgets/window.lisp Mon Sep 11 16:30:56 2006 @@ -153,18 +153,29 @@ color)) (defmethod compute-outer-size ((self window) desired-client-size) - (let ((hwnd (gfs:handle self)) - (new-size (gfs:make-size))) - (gfs::with-rect + (let* ((hwnd (gfs:handle self)) + (has-menu (not (cffi:null-pointer-p (gfs::get-menu hwnd)))) + (new-size (gfs:make-size))) + (gfs::with-rect (rect-ptr) (setf gfs::right (gfs:size-width desired-client-size) gfs::bottom (gfs:size-height desired-client-size)) - (if (zerop (gfs::adjust-window-rect gfs::rect-ptr + (if (zerop (gfs::adjust-window-rect rect-ptr (get-native-style self) - (if (cffi:null-pointer-p (gfs::get-menu hwnd)) 0 1) + (if has-menu 1 0) (get-native-exstyle self))) (error 'gfs:win32-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))) + (gfs:size-height new-size) (- gfs::bottom gfs::top)) + ;; check how much wrapping occurs if there is a menu and we + ;; size a window to the above-computed width and infinite + ;; height + (when has-menu + (setf gfs::bottom #x7FFFFFFF) ; ensures we handle all possible menu wrap + (gfs::send-message hwnd gfs::+wm-nccalcsize+ 0 (cffi:pointer-address rect-ptr)) + ;; gfs::top is now the bottom-most position of the top part of the window's + ;; non-client area, which is the area that the wrapped menu occupies and for + ;; which compensation is needed. + (incf (gfs:size-height new-size) gfs::top))) new-size)) (defmethod gfs:dispose ((self window))