Author: junrue Date: Sun Oct 15 01:46:30 2006 New Revision: 324
Modified: trunk/src/uitoolkit/widgets/scrolling-event-dispatcher.lisp Log: small tweak for previous fix
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:46:30 2006 @@ -132,23 +132,23 @@
(defmethod event-pre-resize ((disp scrolling-event-dispatcher) (window window) rect type) (declare (ignore type)) - (let* ((h-step (gfs:size-width (step-increments disp))) - (v-step (gfs:size-height (step-increments disp))) - (outer-size (gfw:size window)) - (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))) + (let ((h-step (gfs:size-width (step-increments disp))) + (v-step (gfs:size-height (step-increments disp))) + (outer-size (gfw:size window)) + (client-size (gfw:client-size window)) + (pnt (gfs:location rect)) + (size (gfs:size rect))) (when (/= h-step 1) - (let ((amount (+ (* (floor (- (gfs:size-width size) width-diff) h-step) h-step) - width-diff))) + (let* ((width-diff (- (gfs:size-width outer-size) (gfs:size-width client-size))) + (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))) + (let* ((height-diff (- (gfs:size-height outer-size) (gfs:size-height client-size))) + (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)))
graphic-forms-cvs@common-lisp.net