[graphic-forms-cvs] r323 - trunk/src/uitoolkit/widgets

[junrue at common-lisp.net]

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)