| [ Team LiB ] |
|
Selection HandlersThe selection handle command registers a Tcl command to handle selection requests. The command is called to return the value of the selection to a requesting application. If the selection value is large, the command might be called several times to return the selection in pieces. The command gets two parameters that indicate the offset within the selection to start returning data, and the maximum number of bytes to return. If the command returns fewer than that many bytes, the selection request is assumed to be completed. Otherwise, the command is called again to get the rest of the data, and the offset parameter is adjusted accordingly. You can also get a callback when you lose ownership of the selection. At that time it is appropriate to unhighlight the selected object in your interface. The selection own command sets ownership and registers a callback for when you lose ownership. A Canvas Selection HandlerExample 38-3 through Example 38-7 implement cut and paste for a canvas. The CanvasSelect_Demo procedure creates a canvas and sets up some bindings for cut and paste: Example 38-3 Bindings for canvas selection
proc CanvasSelect_Demo { c } {
canvas $c
pack $c
$c create rect 10 10 50 50 -fill red -tag object
$c create poly 100 100 100 30 140 50 -fill orange \
-tag object
# Set up cut and paste bindings
$c bind object <Button-1> [list CanvasSelect $c %x %y]
bind $c <Key-Delete> [list CanvasDelete $c]
bind $c <<Cut>> [list CanvasCut $c]
bind $c <<Copy>> [list CanvasCopy $c]
bind $c <<Paste>> [list CanvasPaste $c]
bind $c <Button-2> [list CanvasPaste $c %x %y]
# Register the handler for selection requests
selection handle $c [list CanvasSelectHandle $c]
}
The CanvasSelect procedure selects an object. It uses the find closest canvas operation to find out what object is under the mouse, which works because the binding is on canvas items with the object tag. If the binding were on the canvas as a whole, you would use the find overlapping operation to limit selection to objects near the mouse click. The CanvasHighlight procedure is used to highlight the selected object. It displays small boxes at the corners of the object's bounding box. Finally, the CanvasSelectLose procedure is registered to be called when another application asserts ownership of the PRIMARY selection. Example 38-4 Selecting objects
proc CanvasSelect { w x y } {
# Select an item on the canvas.
global canvas
set id [$w find closest $x $y]
set canvas(select,$w) $id
CanvasHighlight $w $id
# Claim ownership of the PRIMARY selection
selection own -command [list CanvasSelectLose $w] $w
focus $w
}
proc CanvasHighlight {w id {clear clear}} {
if {$clear == "clear"} {
$w delete highlight
}
foreach {x1 y1 x2 y2} [$w bbox $id] { # lassign }
foreach x [list $x1 $x2] {
foreach y [list $y1 $y2] {
$w create rectangle [expr $x-2] [expr $y-2] \
[expr $x+2] [expr $y+2] -fill black \
-tag highlight
}
}
}
proc CanvasSelectLose { w } {
# Some other app has claimed the selection
global canvas
$w delete highlight
unset canvas(select,$w)
}
Once you claim ownership, Tk calls back to the CanvasSelectHandle procedure when another application, even yours, requests the selection. This uses CanvasDescription to compute a description of the canvas object. It uses canvas operations to query the object's configuration and store that as a command that will create the object: Example 38-5 A canvas selection handler
proc CanvasSelectHandle { w offset maxbytes } {
# Handle a selection request
global canvas
if ![info exists canvas(select,$w)] {
error "No selected item"
}
set id $canvas(select,$w)
# Return the requested chunk of data.
return [string range [CanvasDescription $w $id] \
$offset [expr $offset+$maxbytes]]
}
proc CanvasDescription { w id } {
# Generate a description of the object that can
# be used to recreate it later.
set type [$w type $id]
set coords [$w coords $id]
set config {}
# Bundle up non-default configuration settings
foreach conf [$w itemconfigure $id] {
# itemconfigure returns a list like
# -fill {} {} {} red
set default [lindex $conf 3]
set value [lindex $conf 4]
if {[string compare $default $value] != 0} {
lappend config [lindex $conf 0] $value
}
}
return [concat CanvasObject $type $coords $config]
}
The CanvasCopy procedure puts the description of the selected item onto the clipboard with the clipboard append command. The CanvasDelete deletes an object and the highlighting, and CanvasCut is built from CanvasCopy and CanvasDelete: Example 38-6 The copy and cut operations
proc CanvasCopy { w } {
global canvas
if [info exists canvas(select,$w)] {
set id $canvas(select,$w)
clipboard clear
clipboard append [CanvasDescription $w $id]
}
}
proc CanvasDelete {w} {
global canvas
catch {
$w delete highlight
$w delete $canvas(select,$w)
unset canvas(select,$w)
}
}
proc CanvasCut { w } {
CanvasCopy $w
CanvasDelete $w
}
The CanvasPaste operation gets the value from the CLIPBOARD selection. The selection value has all the parameters needed for a canvas create operation. It gets the position of the new object from the <Button-2> event, or from the current mouse position if the <<Paste>> event is generated. If the mouse is out of the window, then the object is just put into the middle of the canvas. The original position and the new position are used to compute values for a canvas move: Example 38-7 Pasting onto the canvas
proc CanvasPaste { w {x {}} {y {}}} {
# Paste the selection from the CLIPBOARD
if [catch {selection get -selection CLIPBOARD} sel] {
# no clipboard data
return
}
if {[string length $x] == 0} {
# <<Paste>>, get the current mouse coordinates
set x [expr [winfo pointerx $w] - [winfo rootx $w]]
set y [expr [winfo pointery $w] - [winfo rooty $w]]
if {$x < 0 || $y < 0 ||
$x > [winfo width $w] ||
$y > [winfo height $w]} {
# Mouse outside the window - center object
set x [expr [winfo width $w]/2]
set y [expr [winfo height $w]/2]
}
}
if [regexp {^CanvasObject} $sel] {
if [catch {eval {$w create} [lrange $sel 1 end]} id] {
return;
}
# look at the first coordinate to see where to
# move the object. Element 1 is the type, the
# next two are the first coordinate
set x1 [lindex $sel 2]
set y1 [lindex $sel 3]
$w move $id [expr $x-$x1] [expr $y-$y1]
}
}
There is more you can do for a drawing program, of course. You'd like to be able to select multiple objects, create new ones, and more. The ImPress application by Christopher Cox is a full-featured page layout application based on the Tk canvas. You can find it on the Web at:  |
| [ Team LiB ] |
|