1# ruler.tcl -- 2# 3# This demonstration script creates a canvas widget that displays a ruler 4# with tab stops that can be set, moved, and deleted. 5# 6# RCS: @(#) $Id: ruler.tcl,v 1.3 2001/06/14 10:56:58 dkf Exp $ 7 8if {![info exists widgetDemo]} { 9 error "This script should be run from the \"widget\" demo." 10} 11 12# rulerMkTab -- 13# This procedure creates a new triangular polygon in a canvas to 14# represent a tab stop. 15# 16# Arguments: 17# c - The canvas window. 18# x, y - Coordinates at which to create the tab stop. 19 20proc rulerMkTab {c x y} { 21 upvar #0 demo_rulerInfo v 22 $c create polygon $x $y [expr {$x+$v(size)}] [expr {$y+$v(size)}] \ 23 [expr {$x-$v(size)}] [expr {$y+$v(size)}] 24} 25 26set w .ruler 27global tk_library 28catch {destroy $w} 29toplevel $w 30wm title $w "Ruler Demonstration" 31wm iconname $w "ruler" 32positionWindow $w 33set c $w.c 34 35label $w.msg -font $font -wraplength 5i -justify left -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." 36pack $w.msg -side top 37 38frame $w.buttons 39pack $w.buttons -side bottom -fill x -pady 2m 40button $w.buttons.dismiss -text Dismiss -command "destroy $w" 41button $w.buttons.code -text "See Code" -command "showCode $w" 42pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 43 44canvas $c -width 14.8c -height 2.5c 45pack $w.c -side top -fill x 46 47set demo_rulerInfo(grid) .25c 48set demo_rulerInfo(left) [winfo fpixels $c 1c] 49set demo_rulerInfo(right) [winfo fpixels $c 13c] 50set demo_rulerInfo(top) [winfo fpixels $c 1c] 51set demo_rulerInfo(bottom) [winfo fpixels $c 1.5c] 52set demo_rulerInfo(size) [winfo fpixels $c .2c] 53set demo_rulerInfo(normalStyle) "-fill black" 54if {[winfo depth $c] > 1} { 55 set demo_rulerInfo(activeStyle) "-fill red -stipple {}" 56 set demo_rulerInfo(deleteStyle) [list -fill red \ 57 -stipple @[file join $tk_library demos images gray25.bmp]] 58} else { 59 set demo_rulerInfo(activeStyle) "-fill black -stipple {}" 60 set demo_rulerInfo(deleteStyle) [list -fill black \ 61 -stipple @[file join $tk_library demos images gray25.bmp]] 62} 63 64$c create line 1c 0.5c 1c 1c 13c 1c 13c 0.5c -width 1 65for {set i 0} {$i < 12} {incr i} { 66 set x [expr {$i+1}] 67 $c create line ${x}c 1c ${x}c 0.6c -width 1 68 $c create line $x.25c 1c $x.25c 0.8c -width 1 69 $c create line $x.5c 1c $x.5c 0.7c -width 1 70 $c create line $x.75c 1c $x.75c 0.8c -width 1 71 $c create text $x.15c .75c -text $i -anchor sw 72} 73$c addtag well withtag [$c create rect 13.2c 1c 13.8c 0.5c \ 74 -outline black -fill [lindex [$c config -bg] 4]] 75$c addtag well withtag [rulerMkTab $c [winfo pixels $c 13.5c] \ 76 [winfo pixels $c .65c]] 77 78$c bind well <1> "rulerNewTab $c %x %y" 79$c bind tab <1> "rulerSelectTab $c %x %y" 80bind $c <B1-Motion> "rulerMoveTab $c %x %y" 81bind $c <Any-ButtonRelease-1> "rulerReleaseTab $c" 82 83# rulerNewTab -- 84# Does all the work of creating a tab stop, including creating the 85# triangle object and adding tags to it to give it tab behavior. 86# 87# Arguments: 88# c - The canvas window. 89# x, y - The coordinates of the tab stop. 90 91proc rulerNewTab {c x y} { 92 upvar #0 demo_rulerInfo v 93 $c addtag active withtag [rulerMkTab $c $x $y] 94 $c addtag tab withtag active 95 set v(x) $x 96 set v(y) $y 97 rulerMoveTab $c $x $y 98} 99 100# rulerSelectTab -- 101# This procedure is invoked when mouse button 1 is pressed over 102# a tab. It remembers information about the tab so that it can 103# be dragged interactively. 104# 105# Arguments: 106# c - The canvas widget. 107# x, y - The coordinates of the mouse (identifies the point by 108# which the tab was picked up for dragging). 109 110proc rulerSelectTab {c x y} { 111 upvar #0 demo_rulerInfo v 112 set v(x) [$c canvasx $x $v(grid)] 113 set v(y) [expr {$v(top)+2}] 114 $c addtag active withtag current 115 eval "$c itemconf active $v(activeStyle)" 116 $c raise active 117} 118 119# rulerMoveTab -- 120# This procedure is invoked during mouse motion events to drag a tab. 121# It adjusts the position of the tab, and changes its appearance if 122# it is about to be dragged out of the ruler. 123# 124# Arguments: 125# c - The canvas widget. 126# x, y - The coordinates of the mouse. 127 128proc rulerMoveTab {c x y} { 129 upvar #0 demo_rulerInfo v 130 if {[$c find withtag active] == ""} { 131 return 132 } 133 set cx [$c canvasx $x $v(grid)] 134 set cy [$c canvasy $y] 135 if {$cx < $v(left)} { 136 set cx $v(left) 137 } 138 if {$cx > $v(right)} { 139 set cx $v(right) 140 } 141 if {($cy >= $v(top)) && ($cy <= $v(bottom))} { 142 set cy [expr {$v(top)+2}] 143 eval "$c itemconf active $v(activeStyle)" 144 } else { 145 set cy [expr {$cy-$v(size)-2}] 146 eval "$c itemconf active $v(deleteStyle)" 147 } 148 $c move active [expr {$cx-$v(x)}] [expr {$cy-$v(y)}] 149 set v(x) $cx 150 set v(y) $cy 151} 152 153# rulerReleaseTab -- 154# This procedure is invoked during button release events that end 155# a tab drag operation. It deselects the tab and deletes the tab if 156# it was dragged out of the ruler. 157# 158# Arguments: 159# c - The canvas widget. 160# x, y - The coordinates of the mouse. 161 162proc rulerReleaseTab c { 163 upvar #0 demo_rulerInfo v 164 if {[$c find withtag active] == {}} { 165 return 166 } 167 if {$v(y) != $v(top)+2} { 168 $c delete active 169 } else { 170 eval "$c itemconf active $v(normalStyle)" 171 $c dtag active 172 } 173} 174