Scroller.st
changeset 2609 c1f9be6ce48c
parent 2594 48b325aac887
child 2612 be0f78b12b4a
--- a/Scroller.st	Fri Sep 06 18:59:47 2002 +0200
+++ b/Scroller.st	Fri Sep 06 22:52:44 2002 +0200
@@ -22,7 +22,7 @@
 		ghostFrameColor ghostLevel rangeStart rangeEnd rangeStep entered
 		thumbActiveLevel originBeforeMove thumbImage enabled keyboardStep
 		autoRepeat repeatBlock initialRepeatDelay repeatDelay
-		lastMousePosition'
+		lastMousePosition thumbActiveColor'
 	classVariableNames:'HandleShadowForm HandleLightForm DefaultViewBackground
 		DefaultShadowColor DefaultLightColor DefaultThumbColor
 		DefaultThumbShadowColor DefaultThumbLightColor
@@ -32,10 +32,11 @@
 		DefaultThumbLevel DefaultInset DefaultThumbFrameColor
 		DefaultGhostColor DefaultGhostFrameColor DefaultGhostLevel
 		DefaultFixThumbHeight DefaultEdgeStyle DefaultFullViewBackground
-		DefaultThumbEnteredColor DefaultThumbActiveLevel SnapBackDistance
-		DefaultMiddleButtonJump NewCursors DefaultThumbImage HandleImage
-		DefaultHScrollerHeight DefaultVScrollerWidth
-		DefaultStopPagerAtThumb'
+		DefaultThumbEnteredColor DefaultThumbActiveColor
+		DefaultThumbActiveLevel SnapBackDistance DefaultMiddleButtonJump
+		NewCursors DefaultThumbImage HandleImage DefaultHScrollerHeight
+		DefaultVScrollerWidth DefaultStopPagerAtThumb DefaultTallyInset
+		MinThumbSize DefaultTallyDistance'
 	poolDictionaries:''
 	category:'Views-Interactors'
 !
@@ -357,11 +358,12 @@
                        #'scroller.thumbHalfShadowColor' #'scroller.thumbHalfLightColor'
                        #'scroller.thumbFrameColor' #'scroller.ghostColor'
                        #'scroller.ghostLevel'  #'scroller.ghostFrameColor'
-                       #'scroller.NTallyMarks' #'scroller.tallyLevel'
+                       #'scroller.NTallyMarks' #'scroller.tallyLevel' #'scroller.tallyInset'
                        #'scroller.level' #'scroller.borderWidth'
                        #'scroller.thumbLevel' #'scroller.thumbInset'
                        #'scroller.thumbFixHeight' #'scroller.thumbEdgeStyle'
                        #'scroller.thumbEnteredColor' #'scroller.thumbActiveLevel'
+                       #'scroller.thumbActiveColor' 
                        #'scroller.middleButtonJump' 
                        #'scroller.newCursors' 
                        #'scroller.thumbImage' #'scroller.handleImage'
@@ -373,6 +375,7 @@
     DefaultFullViewBackground := StyleSheet colorAt:#'scroller.fullViewBackground'.
     DefaultThumbColor := StyleSheet colorAt:#'scroller.thumbColor'.
     DefaultThumbEnteredColor := StyleSheet colorAt:#'scroller.thumbEnteredColor'.
+    DefaultThumbActiveColor := StyleSheet colorAt:#'scroller.thumbActiveColor'.
     DefaultShadowColor := StyleSheet colorAt:#'scroller.shadowColor'.
     DefaultLightColor := StyleSheet colorAt:#'scroller.lightColor'.
     DefaultThumbShadowColor := StyleSheet colorAt:#'scroller.thumbShadowColor'.
@@ -384,9 +387,12 @@
     DefaultGhostFrameColor := StyleSheet colorAt:#'scroller.ghostFrameColor' default:nil.
     DefaultGhostLevel := StyleSheet at:#'scroller.ghostLevel' default:0.
     DefaultTallyMarks := StyleSheet at:#'scroller.NTallyMarks' default:0.
-    DefaultTallyLevel := 0.
+
+    DefaultTallyLevel := DefaultTallyInset := 0.
     DefaultTallyMarks ~~ 0 ifTrue:[
         DefaultTallyLevel := StyleSheet at:#'scroller.tallyLevel' default:1.
+        DefaultTallyInset := StyleSheet at:#'scroller.tallyInset' default:0.
+        DefaultTallyDistance := StyleSheet at:#'scroller.tallyDistance' default:0.
     ].
     DefaultLevel := StyleSheet at:#'scroller.level' default:0.
     DefaultBorderWidth := StyleSheet at:#'scroller.borderWidth' default:(StyleSheet at:#'borderWidth').
@@ -412,7 +418,8 @@
 
     DefaultStopPagerAtThumb := StyleSheet at:#'scroller.stopPagerAtThumb' default:true.
 
-    SnapBackDistance := 30.
+    SnapBackDistance := StyleSheet at:#'scroller.snapBackDistance' default:30.
+    MinThumbSize := StyleSheet at:#'scroller.minThumbSize' default:8.
 
     "
      self updateStyleCache
@@ -1064,6 +1071,33 @@
 
 !Scroller methodsFor:'drawing'!
 
+drawEdgedLineFrom:x1 y:y1 toX:x2 y:y2 level:lvl
+    |color1 color2 x y|
+
+    "iris style - draw tallys"
+
+    lvl > 0 ifTrue:[
+        color1 := thumbLightColor.
+        color2 := thumbShadowColor.
+    ] ifFalse:[
+        color1 := thumbShadowColor.
+        color2 := thumbLightColor.
+    ].
+
+    self paint:color1.
+    self displayLineFromX:x1 y:y1 toX:x2 y:y2.
+    self paint:color2.
+    x1 = x2 ifTrue:[
+        "/ vertical
+        x := x1 + 1.
+        self displayLineFromX:x y:y1 toX:x y:y2.
+    ] ifFalse:[
+        "/ horizontal
+        y := y1 + 1.
+        self displayLineFromX:x1 y:y toX:x2 y:y.
+    ].
+!
+
 drawHandleFormAtX:x y:y
     thumbShadowColor := thumbShadowColor onDevice:device.
 
@@ -1078,15 +1112,86 @@
     "Modified: / 19.5.1998 / 16:26:49 / cg"
 !
 
+drawTallyMarks
+    "draw the thumb"
+
+    |color1 color2 
+     lvl "{ Class: SmallInteger }"
+     t "{ Class: SmallInteger }"
+     l "{ Class: SmallInteger }"
+     w "{ Class: SmallInteger }"
+     h "{ Class: SmallInteger }"
+     x "{ Class: SmallInteger }"
+     y "{ Class: SmallInteger }"
+     xL xR yT yB dist
+    |
+
+    "iris style - draw tallys"
+
+    lvl := thumbLevel.
+    scrolling ifTrue:[
+        lvl := thumbActiveLevel
+    ].
+
+    w := thumbFrame width.
+    h := thumbFrame height.
+    l := thumbFrame left.
+    t := thumbFrame top.
+
+    tallyLevel > 0 ifTrue:[
+        color1 := thumbLightColor.
+        color2 := thumbShadowColor.
+    ] ifFalse:[
+        color1 := thumbShadowColor.
+        color2 := thumbLightColor.
+    ].
+
+    "draw tally marks"
+
+    (orientation == #vertical) ifTrue:[
+        y := t + (h // 2) - 1.
+        xL := l + lvl - 1 + DefaultTallyInset.
+        xR := l + w - lvl "+ 1" - DefaultTallyInset.
+
+        self drawEdgedLineFrom:xL y:y toX:xR y:y level:tallyLevel.
+
+        tallyMarks > 1 ifTrue:[
+            "dont draw other marks if there is not enough space"
+
+            dist := DefaultTallyDistance ? device verticalPixelPerMillimeter rounded.
+            h > (dist * (tallyMarks * 2)) ifTrue:[
+                self drawEdgedLineFrom:xL y:(y - dist) toX:xR y:(y - dist) level:tallyLevel.
+                self drawEdgedLineFrom:xL y:(y + dist) toX:xR y:(y + dist) level:tallyLevel.
+            ]
+        ]
+    ] ifFalse:[
+        x := l + (w // 2) - 1.
+        yT := t + lvl - 1 + DefaultTallyInset.
+        yB := t + h - lvl "+ 1" - DefaultTallyInset.
+
+        self drawEdgedLineFrom:x y:yT toX:x y:yB level:tallyLevel.
+
+        tallyMarks > 1 ifTrue:[
+            "dont draw other marks if there is not enough space"
+
+            dist := DefaultTallyDistance ? device horizontalPixelPerMillimeter rounded.
+            w > (dist * (tallyMarks * 2)) ifTrue:[
+                self drawEdgedLineFrom:(x - dist) y:yT toX:(x - dist) y:yB level:tallyLevel.
+                self drawEdgedLineFrom:(x + dist) y:yT toX:(x + dist) y:yB level:tallyLevel.
+            ]
+        ]
+    ]
+
+    "Modified: / 29.4.1999 / 09:35:52 / cg"
+!
+
 drawThumb
     "draw the thumb"
 
     |handleX handleY l t lvl
      w "{ Class: SmallInteger }"
      h "{ Class: SmallInteger }"
-     x "{ Class: SmallInteger }"
-     y "{ Class: SmallInteger }"
-     mm xL xR yT yB color1 color2 b r|
+     clr|
 
     (thumbHeight >= 100) ifTrue:[^ self].
     thumbFrame isNil ifTrue:[^ self].
@@ -1096,30 +1201,25 @@
     l := thumbFrame left.
     t := thumbFrame top.
 
-    self paint:(entered ifTrue:[thumbEnteredColor] ifFalse:[thumbColor]).
-    self fillRectangleX:l y:t width:w-1 height:h.
+    clr := entered ifTrue:[thumbEnteredColor] ifFalse:[thumbColor].
+    (scrolling and:[thumbActiveColor notNil]) ifTrue:[clr := thumbActiveColor].
+
+    self paint:clr.
+    self fillRectangleX:l y:t width:w height:h.
 
     lvl := thumbLevel.
     scrolling ifTrue:[
         lvl := thumbActiveLevel
     ].
 
-    lvl == 0 ifTrue:[
-        thumbFrameColor notNil ifTrue:[
-            self paint:thumbFrameColor.
-            self displayRectangleX:l y:t width:w height:h.
-        ].
-        thumbImage notNil ifTrue:[
-            thumbImage displayOn:self x:l y:t
-        ].
-        ^ self
+    lvl ~~ 0 ifTrue:[
+        self drawEdgesForX:l y:t width:w height:h level:lvl
+                    shadow:thumbShadowColor light:thumbLightColor
+                    halfShadow:thumbHalfShadowColor halfLight:thumbHalfLightColor
+                    style:thumbEdgeStyle.
+
     ].
 
-    self drawEdgesForX:l y:t width:w height:h level:lvl
-                shadow:thumbShadowColor light:thumbLightColor
-                halfShadow:thumbHalfShadowColor halfLight:thumbHalfLightColor
-                style:thumbEdgeStyle.
-
     thumbFrameColor notNil ifTrue:[
         self paint:thumbFrameColor.
         self displayRectangleX:l y:t width:w height:h.
@@ -1131,6 +1231,7 @@
 
     (tallyLevel == 0 or:[tallyMarks == 0]) ifTrue:[
         shadowForm notNil ifTrue:[
+            "next style - draw tally bitmap"
             handleX := l + ((w - 8) // 2).
             handleY := t + ((h - 8) // 2).
             self drawHandleFormAtX:handleX y:handleY
@@ -1139,80 +1240,7 @@
     ].
 
     "iris style - draw tallys"
-
-    tallyLevel > 0 ifTrue:[
-        color1 := thumbLightColor.
-        color2 := thumbShadowColor.
-    ] ifFalse:[
-        color1 := thumbShadowColor.
-        color2 := thumbLightColor.
-    ].
-
-    "draw tally marks"
-
-    (orientation == #vertical) ifTrue:[
-        self paint:color1.
-        y := t + (h // 2) - 1.
-        xL := l + lvl - 1.
-        xR := l + w - lvl "+ 1".
-        self displayLineFromX:xL y:y toX:xR y:y.
-        y := y + 1.
-        self paint:color2.
-        self displayLineFromX:xL y:y toX:xR y:y.
-
-        tallyMarks > 1 ifTrue:[
-            "dont draw other marks if there is not enough space"
-
-            mm := device verticalPixelPerMillimeter rounded.
-            h > (mm * (tallyMarks * 2)) ifTrue:[
-                y := y - 1 - mm.
-                self paint:color1.
-                self displayLineFromX:xL y:y toX:xR y:y.
-                y := y + 1.
-                self paint:color2.
-                self displayLineFromX:xL y:y toX:xR y:y.
-
-                y := y - 1 + mm + mm.
-                self paint:color1.
-                self displayLineFromX:xL y:y toX:xR y:y.
-                y := y + 1.
-                self paint:color2.
-                self displayLineFromX:xL y:y toX:xR y:y
-            ]
-        ]
-    ] ifFalse:[
-        x := l + (w // 2) - 1.
-        yT := t + lvl - 1.
-        yB := t + h - lvl "+ 1".
-        self paint:color1.
-        self displayLineFromX:x y:yT toX:x y:yB.
-        self paint:color2.
-        x := x + 1.
-        self displayLineFromX:x y:yT toX:x y:yB.
-
-        tallyMarks > 1 ifTrue:[
-            "dont draw other marks if there is not enough space"
-
-            mm := device horizontalPixelPerMillimeter rounded.
-            w > (mm * (tallyMarks * 2)) ifTrue:[
-                x := x - 1 - mm.
-                self paint:color1.
-                self displayLineFromX:x y:yT toX:x y:yB.
-                x := x + 1.
-                self paint:color2.
-                self displayLineFromX:x y:yT toX:x y:yB.
-
-                x := x - 1 + mm + mm.
-                self paint:color1.
-                self displayLineFromX:x y:yT toX:x y:yB.
-                x := x + 1.
-                self paint:color2.
-                self displayLineFromX:x y:yT toX:x y:yB
-            ]
-        ]
-    ]
-
-    "Modified: / 29.4.1999 / 09:35:52 / cg"
+    self drawTallyMarks.
 !
 
 drawThumbBackgroundInX:x y:y width:w height:h
@@ -1442,7 +1470,10 @@
             ]
         ] ifFalse:[
             pressOffset := curr - limit1.
-            scrolling := true
+            scrolling := true.
+            (thumbActiveColor notNil and:[thumbColor ~~ thumbActiveColor]) ifTrue:[
+                self drawThumb
+            ]
         ]
     ].
 
@@ -1489,6 +1520,9 @@
             thumbLevel ~~ thumbActiveLevel ifTrue:[
                 mustDrawThumb := true
             ].
+            (thumbActiveColor notNil and:[thumbColor ~~ thumbActiveColor]) ifTrue:[
+                mustDrawThumb := true
+            ].
             mustDrawThumb ifTrue:[
                 self drawThumb
             ].    
@@ -1622,11 +1656,11 @@
     in := (frm := self thumbFrame) containsPoint:(x@y).
     (in ~~ entered 
     or:[thumbLevel ~~ thumbActiveLevel]) ifTrue:[
-	entered := in.
-	(thumbColor ~~ thumbEnteredColor 
-	or:[thumbLevel ~~ thumbActiveLevel]) ifTrue: [
-	    self drawThumb
-	].
+        entered := in.
+        (thumbColor ~~ thumbEnteredColor 
+        or:[thumbLevel ~~ thumbActiveLevel]) ifTrue: [
+            self drawThumb
+        ].
     ].
 
     self changeCursorFor:(x@y)
@@ -2011,6 +2045,7 @@
     ].
     thumbLevel := DefaultThumbLevel.
     thumbActiveLevel := DefaultThumbActiveLevel.
+    thumbActiveColor := DefaultThumbActiveColor.
     inset := DefaultInset.
     fixThumbHeight := DefaultFixThumbHeight.
     thumbEdgeStyle := DefaultEdgeStyle.
@@ -2227,12 +2262,12 @@
         "
          do not make thumb too small (for handle & to be catchable)
         "
-        minSz := 10 + (2 * thumbLevel)
+        minSz := MinThumbSize "10" + (2 * thumbLevel)
     ] ifFalse:[
         "
          do not make thumb too small (uncatchable)
         "
-        minSz := 4
+        minSz := MinThumbSize "4"
     ].
 
     (newSize1 < minSz) ifTrue:[
@@ -2574,5 +2609,5 @@
 !Scroller class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libwidg/Scroller.st,v 1.161 2002-08-31 11:34:15 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libwidg/Scroller.st,v 1.162 2002-09-06 20:51:34 cg Exp $'
 ! !