Author: junrue Date: Sun Oct 15 01:39:17 2006 New Revision: 323
Modified: trunk/src/uitoolkit/widgets/scrolling-event-dispatcher.lisp Log: fixed integral resizing misbehavior when left/top-left/top-right/top edges are dragged
Modified: trunk/src/uitoolkit/widgets/scrolling-event-dispatcher.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/scrolling-event-dispatcher.lisp (original) +++ trunk/src/uitoolkit/widgets/scrolling-event-dispatcher.lisp Sun Oct 15 01:39:17 2006 @@ -138,15 +138,20 @@ (client-size (gfw:client-size window)) (width-diff (- (gfs:size-width outer-size) (gfs:size-width client-size))) (height-diff (- (gfs:size-height outer-size) (gfs:size-height client-size))) + (pnt (gfs:location rect)) (size (gfs:size rect))) - (if (/= h-step 1) - (setf (gfs:size-width size) - (+ (* (floor (- (gfs:size-width size) width-diff) h-step) h-step) - width-diff))) - (if (/= v-step 1) - (setf (gfs:size-height size) - (+ (* (floor (- (gfs:size-height size) height-diff) v-step) v-step) - height-diff))) + (when (/= h-step 1) + (let ((amount (+ (* (floor (- (gfs:size-width size) width-diff) h-step) h-step) + width-diff))) + (if (find type '(:bottom-left :left :top-left)) + (decf (gfs:point-x pnt) (- amount (gfs:size-width size)))) + (setf (gfs:size-width size) amount))) + (when (/= v-step 1) + (let ((amount (+ (* (floor (- (gfs:size-height size) height-diff) v-step) v-step) + height-diff))) + (if (find type '(:top-left :top :top-right)) + (decf (gfs:point-y pnt) (- amount (gfs:size-height size)))) + (setf (gfs:size-height size) amount))) (setf (gfs:size rect) size)))
(defmethod event-resize ((disp scrolling-event-dispatcher) (window window) size type)