Version 3 of Canvas rectangle marking

Updated 2003-02-26 19:26:04

Richard Suchenwirth 2002-02-26 - I needed to mark an axis-parallel rectangle on a canvas by drawing it with the mouse pointer. This is a simplified task compared to Canvas item selections, but the solution could also be done simpler, with a single bind proc (which dispatches according to event type), and no global variable required.

In the binding for the <ButtonRelease-1> registration, you specify a "callback": a command name or prefix, to which will be appended a list consisting of the coordinates of the marked rectangle {x0 y0 x1 y1}, and which will then be executed in global scope, as is necessary for bindings:

 proc canvas'rect {w x y type {cmd ""}} {
    set x [$w canvasx $x]
    set y [$w canvasy $y]
    switch -- $type {
        press {
            $w delete rect
            $w create rect $x $y $x $y -tag rect
        }
        motion {
            set item [$w find withtag rect]
            foreach {x0 y0 x1 y1} [$w coords $item] break
            $w coords $item $x0 $y0 $x $y
        }
        release {
            uplevel \#0 [lappend cmd [$w coords [$w find withtag rect]]]
        }
        default {error "bad type $type: use press, motion, or release"}
    }
 }

# Usage example and demo:

 if {[file tail [info script]] == [file tail $argv0]} {
    pack [canvas .c]
    bind .c <1>               {canvas'rect %W %x %y press}
    bind .c <B1-Motion>       {canvas'rect %W %x %y motion}
    bind .c <ButtonRelease-1> {canvas'rect %W %x %y release "diag %W"}

    proc diag {w coords} {
        foreach {x0 y0 x1 y1} $coords break
        $w create line $x0 $y0 $x1 $y1 -fill green -width 3
        $w create line $x1 $y0 $x0 $y1 -fill red -width 3
    }
 }

Arts and Crafts of Tcl-Tk Programming