*** empty log message ***
authorClaus Gittinger <cg@exept.de>
Mon, 09 Mar 2009 15:01:02 +0100
changeset 3662 fb3778b66ce3
parent 3661 010d2b09a8b2
child 3663 6d3cdd2ba023
*** empty log message ***
LinkButton.st
--- a/LinkButton.st	Mon Mar 09 14:34:48 2009 +0100
+++ b/LinkButton.st	Mon Mar 09 15:01:02 2009 +0100
@@ -1,8 +1,8 @@
 "{ Package: 'stx:libwidg2' }"
 
 Button subclass:#LinkButton
-	instanceVariableNames:'labelsAndActions'
-	classVariableNames:''
+	instanceVariableNames:'labelsAndActions mouseOverLabelIndex'
+	classVariableNames:'DefaultLinkColor'
 	poolDictionaries:''
 	category:'Views-Layout'
 !
@@ -33,15 +33,25 @@
     v := StandardSystemView new.
     l := LinkButton in:v.
     l labelsAndActions:{ 
-                        'Hello' -> [ self halt:'Hello'].
+                        'Hello' -> [ Transcript showCR:'Hello Clicked'].
                         ' ' -> nil.
-                        'World' -> [ self halt:'World'].
+                        'World' -> [ Transcript showCR:'World Clicked'].
                        }.
     l foregroundColor:Color blue.
     v open
 "
 ! !
 
+!LinkButton class methodsFor:'defaults'!
+
+updateStyleCache
+    "extract values from the styleSheet and cache them in class variables"
+
+    <resource: #style ( #'linkButton.linkColor' )>
+
+    DefaultLinkColor := StyleSheet colorAt:#'linkButton.linkColor' default:Color blue.
+! !
+
 !LinkButton methodsFor:'accessing'!
 
 labelsAndActions
@@ -65,10 +75,76 @@
 
 defaultControllerClass
     ^ LinkButtonController
+!
+
+initStyle
+    super initStyle.
+
+    level := enterLevel := leaveLevel := onLevel := offLevel := 0.
+    DefaultLinkColor notNil ifTrue:[
+        foreground := DefaultLinkColor onDevice:device.
+    ].
+    activeFgColor := enteredFgColor := foreground.
+    activeBgColor := enteredBgColor := viewBackground.
+!
+
+initialize
+    super initialize.
+    self enableMotionEvents
+! !
+
+!LinkButton methodsFor:'redrawing'!
+
+actionAt:aPoint
+    self labelsAndActionsWithPositionsDo:[:lbl :action :leftX :rightX |
+        (aPoint x between:leftX and:rightX) ifTrue:[
+            ^ action
+        ].
+    ].
+    ^ nil
+!
+
+drawStringLogo:aString x:x y:y
+    "redefined to draw the part under the mouse pointer with an underined emphasis"
+
+    |entered mousePoint|
+
+    mousePoint := controller lastMousePoint.
+    entered := controller entered.
+
+    self labelsAndActionsWithPositionsDo:[:lbl :action :leftX :rightX |
+        |l|
+        l := lbl.
+        (entered and:[mousePoint notNil and:[mousePoint x between:leftX and:rightX]]) ifTrue:[
+            l := l allUnderlined
+        ].
+        self displayString:l x:leftX y:y.
+    ].
+!
+
+labelsAndActionsWithPositionsDo:aFourArgBlock
+    |leftX rightX|
+
+    leftX := labelOriginX.
+    labelsAndActions do:[:assoc | 
+        |lbl wEach|
+
+        lbl := assoc key.
+        wEach := (self font widthOf:lbl on:device).
+        rightX := leftX + wEach-1.
+        aFourArgBlock 
+            value:assoc key
+            value:assoc value
+            value:leftX
+            value:rightX.
+
+        leftX := rightX+1.
+    ].
+    ^ nil
 ! !
 
 !LinkButton class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libwidg2/LinkButton.st,v 1.1 2009-03-05 21:18:55 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libwidg2/LinkButton.st,v 1.2 2009-03-09 14:01:02 cg Exp $'
 ! !