Hosted by |
|
The Tclet below demonstrates some of Tk's capabilities in dealing with structured graphics. Each text line is an item, and it responds differently to mouse actions. Try entering each text item with the mouse, and try dragging it with the left mouse button pressed.
SourceHere is the source (all ~180 lines) of this Tclet: font create ourFont -family Times -size 24 -weight bold set c [canvas .c -background white -bd 1 -relief sunken -highlightthickness 0] pack $c -fill both -expand 1 set ::DELAY 100 set ::AID {} proc raised {c text tc rc x y n tag} { set x1 [expr {$x + 1}] set y1 [expr {$y + 1}] set x0 [expr {$x - 1}] set y0 [expr {$y - 1}] for {set i 0} {$i < $n} {incr i} { $c create text $x1 $y1 -text $text -font ourFont \ -anchor center -fill $rc -tags [list bottom $tag] incr x1 incr y1 } $c create text $x0 $y0 -text $text -font ourFont \ -anchor center -fill white -tags [list top $tag] $c create text $x $y -text $text -font ourFont \ -anchor center -fill $tc -tags [list text $tag] } proc sunken {c text tc sc x y n tag} { set x1 [expr {$x + 1}] set y1 [expr {$y + 1}] set x0 [expr {$x - 1}] set y0 [expr {$y - 1}] for {set i 0} {$i < $n} {incr i} { $c create text $x1 $y1 -text $text -font ourFont \ -anchor center -fill white -tags [list bottom $tag] incr x1 incr y1 } $c create text $x0 $y0 -text $text -font ourFont \ -anchor center -fill $tc -tags [list top $tag] $c create text $x $y -text $text -font ourFont \ -anchor center -fill $sc -tags [list bottom $tag] } proc impressed {c text tc x y tag} { set x1 [expr {$x + 1}] set y1 [expr {$y + 1}] set x0 [expr {$x - 1}] set y0 [expr {$y - 1}] $c create text $x1 $y1 -text $text -font ourFont \ -anchor center -fill white -tags [list bottom $tag] $c create text $x0 $y0 -text $text -font ourFont \ -anchor center -fill black -tags [list top $tag] $c create text $x $y -text $text -font ourFont \ -anchor center -fill $tc -tags [list text $tag] } proc shadowed {c text tc sc x y off tag} { set x2 [expr {$x + $off}] set y2 [expr {$y + $off}] $c create text $x2 $y2 -text $text -font ourFont \ -anchor center -fill $sc -tags [list top $tag] $c create text $x $y -text $text -font ourFont \ -anchor center -fill $tc -tags [list text $tag] } proc startdrag {x y} { global startx starty set startx $x set starty $y } proc movedrag {w x y tag} { global startx starty set dx [expr {$x - $startx}] set dy [expr {$y - $starty}] $w move $tag $dx $dy set startx $x set starty $y } proc raising {c text tc sc x y tag} { set x2 [expr {$x + 1}] set y2 [expr {$y + 1}] $c create text $x2 $y2 -text $text -font ourFont \ -anchor center -fill $sc -tags [list top $tag ${tag}shadow] $c create text $x $y -text $text -font ourFont \ -anchor center -fill $tc -tags [list text $tag ${tag}front] } proc raise {c count limit tag} { if {$count > $limit} { return } incr count set grey grey[expr {$count * 9}] $c itemconfigure ${tag}shadow -fill $grey $c move ${tag}front -1 -1 after cancel $::AID set ::AID [after $::DELAY [list raise $c $count $limit $tag]] } proc lower {c count limit tag} { if {$count > $limit} { $c itemconfigure ${tag}shadow -fill black return } incr count set grey grey[expr {(10 - $count) * 9}] $c itemconfigure ${tag}shadow -fill $grey $c move ${tag}front 1 1 after cancel $::AID set ::AID [after $::DELAY [list lower $c $count $limit $tag]] } proc fading {c text tc x y tag} { $c create text $x $y -text $text -font ourFont \ -anchor center -fill $tc -tags [list top $tag] } proc fade {c tag cur limit} { if {$cur > $limit} { $c itemconfigure $tag -fill grey$limit return } $c itemconfigure $tag -fill grey$cur incr cur 4 after cancel $::AID set ::AID [after $::DELAY [list fade $c $tag $cur $limit]] } proc unfade {c tag cur} { if {$cur < 0} { return } $c itemconfigure $tag -fill grey$cur incr cur -4 after cancel $::AID set ::AID [after $::DELAY [list unfade $c $tag $cur]] } .c bind raised <Button-1> { .c raise raised startdrag %x %y } .c bind raised <B1-Motion> "movedrag %W %x %y raised" .c bind sunken <Button-1> { .c lower sunken startdrag %x %y } .c bind sunken <B1-Motion> "movedrag %W %x %y sunken" .c bind shadowed <Button-1> { .c raise shadowed startdrag %x %y } .c bind shadowed <B1-Motion> "movedrag %W %x %y shadowed" .c bind impressed <Button-1> { .c lower impressed startdrag %x %y } .c bind impressed <B1-Motion> "movedrag %W %x %y impressed" .c bind raising <Enter> "raise .c 0 9 raising" .c bind raising <Leave> "lower .c 0 9 raising" .c bind raising <Button-1> { .c raise raising startdrag %x %y } .c bind raising <B1-Motion> "movedrag %W %x %y raising" .c bind fading <Enter> [list fade .c fading 0 100] .c bind fading <Leave> [list unfade .c fading 100] .c bind fading <Button-1> { .c lower fading startdrag %x %y } .c bind fading <B1-Motion> [list movedrag %W %x %y fading] raised .c "Raised text" green gray40 250 50 8 raised sunken .c "Sunken text" grey20 grey80 250 150 3 sunken shadowed .c "Shadowed, floating text." black grey40 250 250 10 shadowed impressed .c "Impressed text." black 150 100 impressed fading .c "Mouse sensitive text" black 250 300 fading raising .c "Mouse sensitive text" black grey40 250 350 raising |