home *** CD-ROM | disk | FTP | other *** search
/ Practical Programming in Tcl & Tk (4th Edition) / TCLBOOK4.BIN / pc / exsource.old / 34_3.tcl < prev    next >
Text File  |  2003-04-15  |  1KB  |  39 lines
  1. #
  2. # Example 34-3
  3. # An active text button.
  4. #
  5.  
  6. proc TextButton { t start end command } {
  7.     global textbutton
  8.     if ![info exists textbutton(uid)] {
  9.         set textbutton(uid) 0
  10.     } else {
  11.         incr textbutton(uid)
  12.     }
  13.     set tag button$textbutton(uid)
  14.     $t tag configure $tag -relief raised -borderwidth 2
  15.     if {[regexp color [winfo visual $t]]} {
  16.         $t tag configure $tag -background thistle
  17.     } else {
  18.         $t tag configure $tag -background [$t cget -fg]
  19.         $t tag configure $tag -foreground [$t cget -bg]
  20.     }
  21.     # Bind the command to the tag
  22.     $t tag bind $tag <Button-1> $command
  23.     $t tag add $tag $start $end
  24.     # use another tag to remember the cursor
  25.     $t tag bind $tag <Enter> \
  26.         [list TextButtonChangeCursor %W $start $end tcross]
  27.     $t tag bind $tag <Leave> {TextButtonRestoreCursor %W}
  28. }
  29. proc TextButtonChangeCursor {t start end cursor} {
  30.     $t tag add cursor=[$t cget -cursor] $start $end
  31.     $t config -cursor $cursor
  32. }
  33. proc TextButtonRestoreCursor {t} {
  34.     regexp {cursor=([^ ]*)} [$t tag names] x cursor
  35.     $t config -cursor $cursor
  36. }
  37.  
  38.  
  39.