[Richard 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:

[http://mini.net/files/fancy.jpg]

 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
----
[Tk examples] - [Arts and crafts of Tcl-Tk programming]