| 1 | # mkRuler w |
| 2 | # |
| 3 | # Create a canvas demonstration consisting of a ruler. |
| 4 | # |
| 5 | # Arguments: |
| 6 | # w - Name to use for new top-level window. |
| 7 | # This file implements a canvas widget that displays a ruler with tab stops |
| 8 | # that can be set individually. The only procedure that should be invoked |
| 9 | # from outside the file is the first one, which creates the canvas. |
| 10 | |
| 11 | proc mkRuler {{w .ruler}} { |
| 12 | global tk_library |
| 13 | upvar #0 demo_rulerInfo v |
| 14 | catch {destroy $w} |
| 15 | toplevel $w |
| 16 | dpos $w |
| 17 | wm title $w "Ruler Demonstration" |
| 18 | wm iconname $w "Ruler" |
| 19 | set c $w.c |
| 20 | |
| 21 | frame $w.frame1 -relief raised -bd 2 |
| 22 | canvas $c -width 14.8c -height 2.5c -relief raised |
| 23 | button $w.ok -text "OK" -command "destroy $w" |
| 24 | pack append $w $w.frame1 {top fill} $w.ok {bottom pady 10 frame center} \ |
| 25 | $c {expand fill} |
| 26 | message $w.frame1.m -font -Adobe-Times-Medium-R-Normal-*-180-* -aspect 300 \ |
| 27 | -text "This canvas widget shows a mock-up of a ruler. You can create tab stops by dragging them out of the well to the right of the ruler. You can also drag existing tab stops. If you drag a tab stop far enough up or down so that it turns dim, it will be deleted when you release the mouse button." |
| 28 | pack append $w.frame1 $w.frame1.m {frame center} |
| 29 | |
| 30 | set v(grid) .25c |
| 31 | set v(left) [winfo fpixels $c 1c] |
| 32 | set v(right) [winfo fpixels $c 13c] |
| 33 | set v(top) [winfo fpixels $c 1c] |
| 34 | set v(bottom) [winfo fpixels $c 1.5c] |
| 35 | set v(size) [winfo fpixels $c .2c] |
| 36 | set v(normalStyle) "-fill black" |
| 37 | if {[winfo screendepth $c] > 4} { |
| 38 | set v(activeStyle) "-fill red -stipple {}" |
| 39 | set v(deleteStyle) "-stipple @$tk_library/demos/bitmaps/grey.25 \ |
| 40 | -fill red" |
| 41 | } else { |
| 42 | set v(activeStyle) "-fill black -stipple {}" |
| 43 | set v(deleteStyle) "-stipple @$tk_library/demos/bitmaps/grey.25 \ |
| 44 | -fill black" |
| 45 | } |
| 46 | |
| 47 | $c create line 1c 0.5c 1c 1c 13c 1c 13c 0.5c -width 1 |
| 48 | for {set i 0} {$i < 12} {incr i} { |
| 49 | set x [expr $i+1] |
| 50 | $c create line ${x}c 1c ${x}c 0.6c -width 1 |
| 51 | $c create line $x.25c 1c $x.25c 0.8c -width 1 |
| 52 | $c create line $x.5c 1c $x.5c 0.7c -width 1 |
| 53 | $c create line $x.75c 1c $x.75c 0.8c -width 1 |
| 54 | $c create text $x.15c .75c -text $i -anchor sw |
| 55 | } |
| 56 | $c addtag well withtag [$c create rect 13.2c 1c 13.8c 0.5c \ |
| 57 | -outline black -fill [lindex [$c config -bg] 4]] |
| 58 | $c addtag well withtag [rulerMkTab $c [winfo pixels $c 13.5c] \ |
| 59 | [winfo pixels $c .65c]] |
| 60 | |
| 61 | $c bind well <1> "rulerNewTab $c %x %y" |
| 62 | $c bind tab <1> "demo_selectTab $c %x %y" |
| 63 | bind $c <B1-Motion> "rulerMoveTab $c %x %y" |
| 64 | bind $c <Any-ButtonRelease-1> "rulerReleaseTab $c" |
| 65 | } |
| 66 | |
| 67 | proc rulerMkTab {c x y} { |
| 68 | upvar #0 demo_rulerInfo v |
| 69 | $c create polygon $x $y [expr $x+$v(size)] [expr $y+$v(size)] \ |
| 70 | [expr $x-$v(size)] [expr $y+$v(size)] |
| 71 | } |
| 72 | |
| 73 | proc rulerNewTab {c x y} { |
| 74 | upvar #0 demo_rulerInfo v |
| 75 | $c addtag active withtag [rulerMkTab $c $x $y] |
| 76 | $c addtag tab withtag active |
| 77 | set v(x) $x |
| 78 | set v(y) $y |
| 79 | rulerMoveTab $c $x $y |
| 80 | } |
| 81 | |
| 82 | proc rulerMoveTab {c x y} { |
| 83 | upvar #0 demo_rulerInfo v |
| 84 | if {[$c find withtag active] == ""} { |
| 85 | return |
| 86 | } |
| 87 | set cx [$c canvasx $x $v(grid)] |
| 88 | set cy [$c canvasy $y] |
| 89 | if {$cx < $v(left)} { |
| 90 | set cx $v(left) |
| 91 | } |
| 92 | if {$cx > $v(right)} { |
| 93 | set cx $v(right) |
| 94 | } |
| 95 | if {($cy >= $v(top)) && ($cy <= $v(bottom))} { |
| 96 | set cy [expr $v(top)+2] |
| 97 | eval "$c itemconf active $v(activeStyle)" |
| 98 | } else { |
| 99 | set cy [expr $cy-$v(size)-2] |
| 100 | eval "$c itemconf active $v(deleteStyle)" |
| 101 | } |
| 102 | $c move active [expr $cx-$v(x)] [expr $cy-$v(y)] |
| 103 | set v(x) $cx |
| 104 | set v(y) $cy |
| 105 | } |
| 106 | |
| 107 | proc demo_selectTab {c x y} { |
| 108 | upvar #0 demo_rulerInfo v |
| 109 | set v(x) [$c canvasx $x $v(grid)] |
| 110 | set v(y) [expr $v(top)+2] |
| 111 | $c addtag active withtag current |
| 112 | eval "$c itemconf active $v(activeStyle)" |
| 113 | $c raise active |
| 114 | } |
| 115 | |
| 116 | proc rulerReleaseTab c { |
| 117 | upvar #0 demo_rulerInfo v |
| 118 | if {$v(y) != [expr $v(top)+2]} { |
| 119 | $c delete active |
| 120 | } else { |
| 121 | eval "$c itemconf active $v(normalStyle)" |
| 122 | $c dtag active |
| 123 | } |
| 124 | } |