fix ViewScroller in scrolledView
authortm
Wed, 16 Jun 1999 14:22:08 +0200
changeset 1412 b426fae6edcf
parent 1411 05ffc8ae696e
child 1413 fa86dd0c4246
fix ViewScroller in scrolledView
SubCanvas.st
--- a/SubCanvas.st	Wed Jun 16 14:21:03 1999 +0200
+++ b/SubCanvas.st	Wed Jun 16 14:22:08 1999 +0200
@@ -12,7 +12,8 @@
 
 
 ScrollableView subclass:#SubCanvas
-	instanceVariableNames:'builder spec client clientHolder specHolder'
+	instanceVariableNames:'builder spec client clientHolder specHolder clientView
+		clientViewIsScrolled'
 	classVariableNames:''
 	poolDictionaries:''
 	category:'Views-Basic'
@@ -98,6 +99,23 @@
   ^ builder
 !
 
+makeClientViewScrollable:aBoolean
+    |vs|
+
+    aBoolean ~~ clientViewIsScrolled ifTrue:[
+        clientView := View new.
+
+        aBoolean ifTrue:[
+            self scrolledView:(vs := ViewScroller new).
+            vs scrolledView:clientView.
+        ] ifFalse:[
+            self scrolledView:clientView.
+        ].
+        clientViewIsScrolled := aBoolean.
+    ]
+
+!
+
 spec
     "return the value of the instance variable 'spec' (automatically generated)"
 
@@ -156,10 +174,10 @@
 rebuild
     "rebuild
     "
-    |subSpec savedView builderClass|
+    |v subSpec savedView builderClass|
 
-    scrolledView notNil ifTrue:[
-        scrolledView destroySubViews
+    clientView notNil ifTrue:[
+        clientView destroySubViews
     ].
 
     spec notNil ifTrue:[
@@ -184,18 +202,23 @@
         ].
 
         "/ old:
-"/         builder buildFromSpec:subSpec in:scrolledView.
+"/         builder buildFromSpec:subSpec in:clientView.
 
         "/ new (let app know (somehow) that this is a build
         "/ for a subcanvas (i.e. it can redefine the buildSubCanvase-method
         "/:
         savedView := builder window.
-        builder window:scrolledView.
+        builder window:clientView.
         client buildSubCanvas:subSpec withBuilder:builder.
         builder window:savedView.
 
+        clientViewIsScrolled ifTrue:[
+            clientView
+                extent:(builder spec window layout rectangleRelativeTo:self bounds preferred:nil) extent.
+        ].
+
         self realized ifTrue:[
-            scrolledView realizeAllSubViews
+            clientView realizeAllSubViews
         ]
     ]
 
@@ -203,7 +226,7 @@
 !
 
 releaseAllComponents
-    scrolledView destroySubViews.
+    clientView destroySubViews.
     builder := nil.
     spec    := nil.
     client  := nil.
@@ -262,8 +285,12 @@
 !
 
 initialize
+
     super initialize.
-    self scrolledView:View new.
+
+    self scrolledView:(clientView := View new).
+    clientViewIsScrolled := false.
+
     spec := #windowSpec.
 ! !
 
@@ -283,5 +310,5 @@
 !SubCanvas class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libwidg2/SubCanvas.st,v 1.11 1999-05-21 16:26:11 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libwidg2/SubCanvas.st,v 1.12 1999-06-16 12:22:08 tm Exp $'
 ! !