3 # This demonstration script creates a canvas widget that displays a ruler
4 # with tab stops that can be set, moved, and deleted.
6 if {![info exists widgetDemo
]} {
7 error "This script should be run from the \"widget\" demo."
13 # This procedure creates a new triangular polygon in a canvas to
14 # represent a tab stop.
17 # c - The canvas window.
18 # x, y - Coordinates at which to create the tab stop.
20 proc 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
)}]
29 wm title
$w "Ruler Demonstration"
30 wm iconname
$w "ruler"
34 label $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."
37 ## See Code / Dismiss buttons
38 set btns
[addSeeDismiss
$w.buttons
$w]
39 pack $btns -side bottom
-fill x
41 canvas $c -width 14.8c
-height 2.5c
42 pack $w.c
-side top
-fill x
44 set demo_rulerInfo
(grid) .25c
45 set demo_rulerInfo
(left
) [winfo fpixels
$c 1c
]
46 set demo_rulerInfo
(right
) [winfo fpixels
$c 13c
]
47 set demo_rulerInfo
(top
) [winfo fpixels
$c 1c
]
48 set demo_rulerInfo
(bottom
) [winfo fpixels
$c 1.5c
]
49 set demo_rulerInfo
(size
) [winfo fpixels
$c .2c
]
50 set demo_rulerInfo
(normalStyle
) "-fill black"
51 # Main widget program sets variable tk_demoDirectory
52 if {[winfo depth
$c] > 1} {
53 set demo_rulerInfo
(activeStyle
) "-fill red -stipple {}"
54 set demo_rulerInfo
(deleteStyle
) [list -fill red
\
55 -stipple @[file join $tk_demoDirectory images gray25.xbm
]]
57 set demo_rulerInfo
(activeStyle
) "-fill black -stipple {}"
58 set demo_rulerInfo
(deleteStyle
) [list -fill black
\
59 -stipple @[file join $tk_demoDirectory images gray25.xbm
]]
62 $c create line
1c
0.5c
1c
1c
13c
1c
13c
0.5c
-width 1
63 for {set i
0} {$i < 12} {incr i
} {
65 $c create line
${x
}c
1c
${x
}c
0.6c
-width 1
66 $c create line
$x.25c
1c
$x.25c
0.8c
-width 1
67 $c create line
$x.5c
1c
$x.5c
0.7c
-width 1
68 $c create line
$x.75c
1c
$x.75c
0.8c
-width 1
69 $c create
text $x.15c
.75c
-text $i -anchor sw
71 $c addtag well withtag
[$c create rect
13.2c
1c
13.8c
0.5c
\
72 -outline black
-fill [lindex [$c config
-bg] 4]]
73 $c addtag well withtag
[rulerMkTab
$c [winfo pixels
$c 13.5c
] \
74 [winfo pixels
$c .65c
]]
76 $c bind well
<1> "rulerNewTab $c %x %y"
77 $c bind tab
<1> "rulerSelectTab $c %x %y"
78 bind $c <B1-Motion
> "rulerMoveTab $c %x %y"
79 bind $c <Any-ButtonRelease-1
> "rulerReleaseTab $c"
82 # Does all the work of creating a tab stop, including creating the
83 # triangle object and adding tags to it to give it tab behavior.
86 # c - The canvas window.
87 # x, y - The coordinates of the tab stop.
89 proc rulerNewTab
{c x y
} {
90 upvar #0 demo_rulerInfo v
91 $c addtag active withtag
[rulerMkTab
$c $x $y]
92 $c addtag tab withtag active
99 # This procedure is invoked when mouse button 1 is pressed over
100 # a tab. It remembers information about the tab so that it can
101 # be dragged interactively.
104 # c - The canvas widget.
105 # x, y - The coordinates of the mouse (identifies the point by
106 # which the tab was picked up for dragging).
108 proc rulerSelectTab
{c x y
} {
109 upvar #0 demo_rulerInfo v
110 set v
(x
) [$c canvasx
$x $v(grid)]
111 set v
(y
) [expr {$v(top
)+2}]
112 $c addtag active withtag current
113 eval "$c itemconf active $v(activeStyle)"
118 # This procedure is invoked during mouse motion events to drag a tab.
119 # It adjusts the position of the tab, and changes its appearance if
120 # it is about to be dragged out of the ruler.
123 # c - The canvas widget.
124 # x, y - The coordinates of the mouse.
126 proc rulerMoveTab
{c x y
} {
127 upvar #0 demo_rulerInfo v
128 if {[$c find withtag active
] == ""} {
131 set cx
[$c canvasx
$x $v(grid)]
132 set cy
[$c canvasy
$y]
133 if {$cx < $v(left
)} {
136 if {$cx > $v(right
)} {
139 if {($cy >= $v(top
)) && ($cy <= $v(bottom
))} {
140 set cy
[expr {$v(top
)+2}]
141 eval "$c itemconf active $v(activeStyle)"
143 set cy
[expr {$cy-$v(size
)-2}]
144 eval "$c itemconf active $v(deleteStyle)"
146 $c move active
[expr {$cx-$v(x
)}] [expr {$cy-$v(y
)}]
152 # This procedure is invoked during button release events that end
153 # a tab drag operation. It deselects the tab and deletes the tab if
154 # it was dragged out of the ruler.
157 # c - The canvas widget.
158 # x, y - The coordinates of the mouse.
160 proc rulerReleaseTab c
{
161 upvar #0 demo_rulerInfo v
162 if {[$c find withtag active
] == {}} {
165 if {$v(y
) != $v(top
)+2} {
168 eval "$c itemconf active $v(normalStyle)"