PopUpList.st
changeset 1758 30ad727ade43
parent 1587 8cacd0f9ed92
child 1772 7ac24130dd51
--- a/PopUpList.st	Fri Mar 05 11:10:39 1999 +0100
+++ b/PopUpList.st	Fri Mar 05 23:48:47 1999 +0100
@@ -11,7 +11,8 @@
 "
 
 Button subclass:#PopUpList
-	instanceVariableNames:'menu menuAction values useIndex listMsg defaultLabel listHolder'
+	instanceVariableNames:'menu menuAction values useIndex listMsg defaultLabel listHolder
+		showHandle'
 	classVariableNames:''
 	poolDictionaries:''
 	category:'Views-Interactors'
@@ -539,6 +540,14 @@
     "Modified: 27.2.1997 / 10:24:12 / cg"
 ! !
 
+!PopUpList methodsFor:'accessing - look'!
+
+showHandle:aBoolean
+    "controls if the pull-handle is to be drawn; default is true"
+
+    showHandle := aBoolean
+! !
+
 !PopUpList methodsFor:'accessing-behavior'!
 
 action:aOneArgBlock
@@ -683,17 +692,20 @@
     |mmH mmV mW mH|
 
     controller pressed ifTrue:[
-	super drawWith:enteredFgColor and:enteredBgColor
+        super drawWith:enteredFgColor and:enteredBgColor
     ] ifFalse:[
-	super drawWith:fgColor and:bgColor.
+        super drawWith:fgColor and:bgColor.
     ].
-    mmH := device horizontalPixelPerMillimeter rounded.
-    mmV := device verticalPixelPerMillimeter rounded.
-    mW := (device horizontalPixelPerMillimeter * 2.5) rounded.
-    mH := (device verticalPixelPerMillimeter * 1.5) rounded.
 
-    self drawEdgesForX:(width - mW - (hSpace*2)) y:(height - mmV // 2)
-		 width:mW height:mH level:2
+    showHandle ifTrue:[
+        mmH := device horizontalPixelPerMillimeter rounded.
+        mmV := device verticalPixelPerMillimeter rounded.
+        mW := (device horizontalPixelPerMillimeter * 2.5) rounded.
+        mH := (device verticalPixelPerMillimeter * 1.5) rounded.
+
+        self drawEdgesForX:(width - mW - (hSpace*2)) y:(height - mmV // 2)
+                     width:mW height:mH level:2
+    ].
 !
 
 showActive
@@ -784,6 +796,8 @@
     self adjust:#left.
     useIndex := false.
     defaultLabel := 'popup'.
+    showHandle := true.
+
     super label:defaultLabel.
 
     listMsg := self class defaultListMessage.
@@ -998,5 +1012,5 @@
 !PopUpList class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libwidg/PopUpList.st,v 1.57 1998-06-18 23:58:08 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libwidg/PopUpList.st,v 1.58 1999-03-05 22:48:47 tm Exp $'
 ! !