Here's the newgroup message that introduced Canvas Buttons. Rick Hedin wrote: > We have come to a place where it seems desireable to have lightweight > widgets within a canvas. The Java folks are all excited about lightweight > widgets that share a single window, and Swing, and whatnot. Has similar > work been done within Tcl? You can do a lot by tagging groups of canvas items and binding to their tags. The enclosed code, for instance, creates canvas items that look and act a lot like buttons. The idea of making Tk widgets themselves leaner has also been pursued. The TkGS project is trying to do it. There's information on that at http://www.purl.org/net/bonnet/Tcl/TkGS/ and http://www.sourceforge.net/projects/tkgs/ -- Kevin KENNY GE Corporate R&D, Niskayuna, New York, USA ---- Here's the code for Canvas Buttons. # ---------------------------------------------------------------------- # # cbutton.tcl -- # # Example of how to provide button-like behavior on canvas # items. (Posted on comp.lang.tcl by Kevin Kenny) set ::RCSID([info script]) \ {$Id: 1383,v 1.1 2002-06-21 03:04:50 jcw Exp $} package provide canvasbutton 1.0 namespace eval canvasbutton { # nexttag - Next unique tag number for a "button" being # created variable nexttag 0 # command - command(tag#) contains the command to execute when # a "button" is selected. variable command # cursor - cursor(pathName) contains the (saved) cursor # symbol of the widget when the pointer is in # a "button" variable cursor # enteredButton - contains the tag number of the button # containing the pointer. variable enteredButton {} # pressedButton - contains the tag number of the "button" # in which the mouse button was pressed variable pressedButton {} namespace export canvasbutton } # ---------------------------------------------------------------------- # # canvasbutton::canvasbutton -- # # Create a button-like object on a canvas. # # Parameters: # w Path name of the canvas # x0 Canvas X co-ordinate of left edge # y0 Canvas Y co-ordinate of top edge # x1 Canvas X co-ordinate of right edge # y1 Canvas Y co-ordinate of bottom edge # text Text to display in the button # cmd Command to execute when the button is selected. # # Results: # Unique canvas tag assigned to the items that make # up the button. # # Side effects: # A rectangle and a text item are created in the canvas, # and bindings are established to give them button-like # behavior. # #---------------------------------------------------------------------- proc canvasbutton::canvasbutton {w x0 y0 x1 y1 text cmd} { variable nexttag variable command set btag [list canvasb# [incr nexttag]] set command($btag) $cmd $w create rectangle $x0 $y0 $x1 $y1 \ -fill white -outline black -width 1 \ -tags [list canvasb $btag [linsert $btag end frame]] set x [expr { ($x0+$x1) / 2 }] set y [expr { ($y0+$y1) / 2 }] $w create text $x $y -anchor center -justify center \ -text $text \ -tags [list canvasb $btag [linsert $btag end text]] $w bind canvasb [list [namespace current]::enter %W] $w bind canvasb [list [namespace current]::leave %W] $w bind canvasb \ [list [namespace current]::press %W] $w bind canvasb \ [list [namespace current]::release %W] return $btag } # ---------------------------------------------------------------------- # # canvasbutton::enter -- # # Process the event on a canvas-button. # # Parameters: # w Path name of the canvas # # Results: # None. # # Side effects: # When the mouse pointer is in a button, the button is # highlighted with a broad outline and the cursor # symbol changes to an arrow. When the active button # is pressed, it is highlighted in green. # # ---------------------------------------------------------------------- proc canvasbutton::enter {w} { variable enteredButton variable pressedButton variable cursor set enteredButton [findBtag $w] set frame [linsert $enteredButton end frame] set cursor($w) [$w cget -cursor] $w configure -cursor arrow $w itemconfigure $frame -width 3 if {![string compare $enteredButton $pressedButton]} { $w itemconfigure $frame -fill green } } # ---------------------------------------------------------------------- # # canvasbutton::leave -- # # Process the event on a canvas-button. # # Parameters: # w Path name of the canvas # # Results: # None. # # Side effects: # Reverts the cursor symbol, the border width # if needed, the highlight color of the button. # # ---------------------------------------------------------------------- proc canvasbutton::leave {w} { variable enteredButton variable pressedButton variable cursor if {[string compare $enteredButton {}]} { set btag [findBtag $w] set frame [linsert $btag end frame] $w itemconfigure $frame -width 1 $w configure -cursor $cursor($w) unset cursor($w) if {![string compare $btag $pressedButton]} { $w itemconfigure $frame -fill white } set enteredButton {} } return } # ---------------------------------------------------------------------- # # canvasbutton::press -- # # Process the event on a canvas-button. # # Parameters: # w Path name of the canvas # # Results: # None. # # Side effects: # Highlights the selected button in green. # # ---------------------------------------------------------------------- proc canvasbutton::press {w} { variable pressedButton set pressedButton [findBtag $w] $w itemconfigure [linsert $pressedButton end frame] \ -fill green return } # ---------------------------------------------------------------------- # # canvasbutton::release -- # # Process the event on a canvas-button. # # Parameters: # w Path name of the canvas # # Results: # None. # # Side effects: # Reverts the highlight color on the button. If the # mouse has not left the button, invokes the button's # command. # # ---------------------------------------------------------------------- proc canvasbutton::release {w} { variable enteredButton variable pressedButton variable command set pressedButtonWas $pressedButton set pressedButton {} $w itemconfigure [linsert $pressedButtonWas end frame] \ -fill white if {![string compare $enteredButton $pressedButtonWas]} { uplevel #0 $command($pressedButtonWas) } return } # ---------------------------------------------------------------------- # # canvasbutton::btag -- # # Locate the unique tag of a canvas-button # # Parameters: # w Path name of the canvas # # Results: # Button tag, or the null string if the current # item is not a canvas-button # # Side effects: # Searches the tag list of the current canvas item # for a tag that begins with the string, `canvasb#', # and returns the first two elements of the tag # interpreted as a Tcl list. # # ---------------------------------------------------------------------- proc canvasbutton::findBtag {w} { foreach tag [$w itemcget current -tags] { if {[regexp {^canvasb#} [lindex $tag 0]]} { return [lrange $tag 0 1] } } return {} } if {![string compare $argv0 [info script]]} { grid [canvas .c -width 300 -height 200 -cursor crosshair] namespace import canvasbutton::* .c create text 150 150 -anchor n -tags label \ -font {Helvetica 10 bold} canvasbutton .c 10 60 90 140 "First\nButton" { .c itemconfigure label -text One } canvasbutton .c 110 60 190 140 "Second\nButton" { .c itemconfigure label -text Two } canvasbutton .c 210 60 290 140 "Third\nButton" { .c itemconfigure label -text Three } canvasbutton .c 240 160 290 190 "Quit" exit } ---- Here's a link to a version of Canvas Buttons where you can watch the button depress when you click it, and spring back when you release it. [Canvas Buttons in 3-D]