Scale.st
changeset 1 c6ca7bfedf31
child 34 159147b254e1
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Scale.st	Wed Oct 13 02:03:30 1993 +0100
@@ -0,0 +1,69 @@
+"
+ COPYRIGHT (c) 1993 by Claus Gittinger
+              All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice.   This software may not
+ be provided or otherwise made available to, or used by, any
+ other person.  No title to or ownership of the software is
+ hereby transferred.
+"
+
+View subclass:#Scale
+	 instanceVariableNames:'slider range action'
+	 classVariableNames:''
+	 poolDictionaries:''
+	 category:'Views-Interactors'
+!
+
+!Scale methodsFor:'slider actions'!
+
+scroll:percent
+    |value y label|
+
+    action notNil ifTrue:[
+        value := (range last - range first) * (percent / 100).
+        value := value + range first.
+        action value:value.
+
+        y := slider thumbFrame top + (slider thumbFrame height // 2).
+        self clear.
+        self paint:Black.
+        value := value roundTo:(range last - range first) / 100.
+        label := value asFloat printString.
+        (label endsWith:'.0') ifTrue:[
+            label := value asInteger printString
+        ].
+        self displayString:label
+                         x:slider width + device horizontalPixelPerMillimeter
+                         y:y + (font ascent // 2)
+    ]
+! !
+
+!Scale methodsFor:'accessing'!
+
+range:anInterval
+    range := anInterval
+!
+
+scrollAction:aBlock
+    action := aBlock
+! !
+
+!Scale methodsFor:'initialization'!
+
+initialize
+    super initialize.
+
+    range := (0 to:100).
+    slider := Slider in:self.
+    slider origin:0.0 @ 0.0.
+    slider extent:slider width@ 1.0.
+    self width:(slider width  
+                + (font widthOf:'100')
+                + (device horizontalPixelPerMillimeter * 2) rounded).
+
+    slider scrollAction:[:percent | self scroll:percent].
+! !
+