Version 1 of Alternative buttons on canvas
Updated 2007-02-14 13:47:46 by suchenwiRichard Suchenwirth 2001-04-09 - Sometimes people want fancier UI objects than Tk's standard set. Here's a little experiment I made to produce rectangular "buttons" with a semicircular edge, with a certain 3D effect and animation on pushing:
proc sec:yesnohelp {w args} {
array set opts {
-title "Operation Control"
-text "Do you really want to quit?"
}
array set opts $args
toplevel $w
wm title $w $opts(-title)
pack [canvas $w.c -bg #FDFDFD -width 220 -height 155] -fill both -expand 1
sec:button $w.c 100 15 Help
$w.c create text 5 55 -text $opts(-text) -anchor nw
sec:button $w.c 100 80 NO
sec:button $w.c 100 120 YES
}
proc sec:button {c x y text} {
set r 25
$c create rect [expr $x+$r/2.] [expr $y+2] \
[$c cget -width] [expr $y+$r+2] -fill black -tags [list _$text bt]
$c create oval [expr $x] [expr $y+2] [expr $x+$r+2] [expr $y+$r+2] \
-fill black -tags [list _$text bt]
$c create rect [expr $x+$r/2.] $y \
[$c cget -width] [expr $y+$r] -fill gray70 -tags [list _$text bt]
$c create oval $x $y [expr $x+$r] [expr $y+$r] -fill gray70 \
-tags [list _$text bt]
$c create rect [expr $x+$r/2.] [expr $y+1] [expr $x+$r] [expr $y+$r-1] \
-fill gray70 -outline gray70 -tag [list _$text bt]
$c create text [expr $x+$r-5] [expr $y+$r/2.] -text $text -anchor w \
-tags [list _$text bt]
$c bind _$text <1> [list $c move _$text 2 2]
$c bind _$text <ButtonRelease-1> [list $c move _$text -2 -2]
}
wm withdraw .
sec:yesnohelp .1 -text "Do you really want to quit?"
.1.c bind _YES <ButtonRelease-1> exit