binding multiple canvas objects for dnd.

From: Stephen K. Long (stephen.k.long_at_earthlink.net)
Date: 10/30/04 

Date: Sat, 30 Oct 2004 16:18:24 GMT

Hi all,
I'm working on learning the canvas widget. I've been hacking on code
snippets from Welch's 3rd edition since I use 80p2. I have a problem with
selecting more then one object on my canvas to dnd. I've been trying to use
bind Control-Button-1 to collect each object so that all associated objects
move with my B1-Motion bind. Here is what I have sofar,

proc CanvasMark {can x y} {
 global canvas
 # Map from view coordinates to canvas coordinates
 set x [$can canvasx $x]
 set y [$can canvasy $y]
 # Remember the object and its location
 set canvas($can,obj) [$can find closest $x $y]
 set canvas(select,$can) $canvas($can,obj)
 set canvas($can,x) $x
 set canvas($can,y) $y
 CanvasHighlight $can $canvas($can,obj)
 # Claim ownership of the PRIMARY selection
 selection own -command [list CanvasSelectLose $can] $can
 focus $can
}
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)
}

proc CanvasSelect_Demo { c } {
 # Create a canvas with a couple of objects
 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
 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]
 bind $c <Control-Button-1> [lappend object %W]
 $c bind object <Button-1> [CanvasMark %W %x %y]
 $c bind object <B1-Motion> [CanvasDrag %W %x %y ]
 # Register the handler for selection requests
 selection handle $c [list CanvasSelectHandle $c]
}
proc CanvasDrag {can x y} {
 global canvas
 # Map from view coordinates to canvas coordinates
 set x [$can canvasx $x]
 set y [$can canvasy $y]
 # Move the current object
 set dx [expr $x - $canvas($can,x)]
 set dy [expr $y - $canvas($can,y)]
 $can move $canvas($can,obj) $dx $dy
 $can move highlight $dx $dy
 set canvas($can,x) $x
 set canvas($can,y) $y
}
CanvasSelect_Demo .can

Any help is appreciated.

Stephen

Quantcast