Tcl/Tk 烹调书 -
重访画布 Tcl/Tk 烹调书 -
重访画布脚本
译者按：余修改了部分代码。
我们打算向画布组件添加一些绑定 :
为此，给画布设置三个绑定:
bind .can <Button-1> {GetStarted %x %y}
bind .can <ButtonRelease-1> { LetGo %x %y}
bind .can <Button1-Motion> {KeepMoving %x %y}
每个用户事件调用相关的操作(过程/函数/行为)并把当前的位置作为参数传递给它。这个三个事件的脚本定义如下:
proc GetStarted {x y} {
global x1 y1 sb so str eo lw
set x1 $x
set y1 $y
if {[string compare $sb ""] == 0 } {
return
}
if {[string compare $sb "text"] == 0 && ${str} != "" } {
set so [.can create text $x $y -text $str -anchor sw]
.can addtag $sb$so closest $x $y
return
}
if { [string compare $sb "obj"] == 0} {
set so [.can create rectangle $x $y $x $y -fill {} -outline red]
set eo $so
return
}
if {[string compare $sb "line"] == 0 } {
set so [.can create $sb $x1 $y1 $x $y ]
.can addtag $sb$so enclosed $x1 $y1 $x $y
} else {
set so [.can create $sb $x1 $y1 $x $y -fill {} -outline black ]
.can addtag $sb$so enclosed $x1 $y1 $x $y
}
}
proc KeepMoving {x y} {
global x1 y1 so sb
if {[string compare $sb ""] == 0 } {
return
}
if {[string compare $sb "text"] == 0 } {
return
}
.can coords $so $x1 $y1 $x $y
}
proc LetGo {x y} {
global x1 y1 so sb eo
if {[string compare $sb ""] == 0 } {
return
}
if { [string compare $sb "obj"] == 0} {
set so [.can find enclosed $x1 $y1 $x $y]
foreach s $so {
if { [string compare -length 4 [.can gettags $s] "text"] == 0} {
.can itemconfigure $s -fill green
} elseif { [string compare -length 4 [.can gettags $s] "line"] == 0} {
.can itemconfigure $s -fill green
} else {
.can itemconfigure $s -fill {} -outline green
}
}
.can delete $eo
}
}
proc GetStarted {x y} {
global x1 y1 sb so str eo
set x1 $x
set y1 $y
if {[string compare $sb "text"] == 0 } {
set so [.can create text $x $y -text $str -anchor sw]
return
}
if { [string compare $sb "obj"] == 0} {
set so [.can create rectangle $x $y $x $y -fill {} -outline red]
set eo $so
return
}
if {[string compare $sb "line"] == 0 } {
set so [.can create $sb $x1 $y1 $x $y ]
.can addtag $sb$so enclosed $x1 $y1 $x $y
} else {
set so [.can create $sb $x1 $y1 $x $y -fill {} -outline black ]
.can addtag $sb$so enclosed $x1 $y1 $x $y
}
}
proc KeepMoving {x y} {
global x1 y1 so sb
if {[string compare $sb "text"] == 0 } {
return
}
.can coords $so $x1 $y1 $x $y
}
proc LetGo {x y} {
global x1 y1 so sb eo
if { [string compare $sb "obj"] == 0} {
set so [.can find enclosed $x1 $y1 $x $y]
.can itemconfigure $so -fill {} -outline green
.can delete $eo
}
}
过程 "GetStarted" 检查 "sb" 的当前值。如果选择的基本操作是 text，则绘制的字符串项目被定位(anchor)在用 x,y 值指定的当前位置的南西方向上。
如果 "sb" 指向 "select an object"，则建立一个有红色轮廓的矩形对象(物体)并且把这个矩形的 id 赋给变量 "eo" (用于以后有选择性的删除它)。
在所有其他情况下从 x,y (左上角) 到 x1,y1(右下角)绘制物体/项目。使用组件命令 .can 的动作 addtag 来填加由"sb"的值和对象(物体)的唯一标识串联成的一个标签名。
过程 "KeepMoving" 在"sb" 是 "text"的情况下不做任何事就返回。在所有其他情况下，组件命令 .can 调用 coordinates 动作。给这个动作的第一个参数识对象的 id (或标签)。如果不进一步指定参数，这个动作将返回对象的坐标的一个列表。如果给这个动作一些坐标值，则它将把对象(第一个参数)的坐标修改/重置成这些给定的值。
如果 "sb" 被设置成 "obj" 则过程 "LetGo" 调用 ".can find "查找所有包含的对象/项目的标识。如果找到一个包含的对象/项目，使用组件动作 itemconfigure 把它的边界被重置为绿色。
当你选择的项目是一个文本串的时候看会发生什么。
proc CutSelection {} {
global so
.can delete $so
}
proc clearCanvas {} {
foreach id [.can find all] { .can delete $id }
}
proc printCanvas {} {
.can postscript -file "canvas.ps"
}
过程 "CutSelection" 删除当前选择的或最近绘制的项目。
过程 "clearCanvas" 得到所有项目的显示列表并一个接一个的删除它们。
在 "printCanvas" 中，调用 Tk 画布组件动作 postscript 并加以 "-file" 选项。画布内容的 postscript 将被保存在当前工作目录下的 "canvas.ps" 中。注意如果你没有在当前工作目录中写的权限 Tk 会抱怨的。
