Updated 2013-01-18 21:04:19 by pooryorick

Arjen Markus I needed a script to move and scale the contents of a canvas. RS suggested that this can be achieved with a few event bindings. He, of course, was right as usual. It is slightly more complicated than one-line commands, but still, it can hardly be easier.

Notes:

  • In the actual script I use so-called world coordinates to transform metric coordinates to and from pixel coordinates. So the procedures get more complicated to update the transformation data.
  • If the number of items gets large (a few hundred or a few thousand, as in my case), you can notice a delay between the updates. I use a slightly different method for this situation - control-arrow-keys to shift it a known number of pixels. But the principle stays the same.
# Experiment with scale/move items in a canvas
#
proc moveItems { x y } {
    global xc yc
    
    if { [info exists ::xc] } {
        .c move all [expr {$x-$xc}] [expr {$y-$yc}]
    }   
    set xc $x
    set yc $y
}

proc scaleItems { type x y } {
  
    if { $type eq "+" } {
        .c scale all $x $y [expr {sqrt(2.0)}] [expr {sqrt(2.0)}]
    } else {
        .c scale all $x $y [expr {1.0/sqrt(2.0)}] [expr {1.0/sqrt(2.0)}]
    }  
}

pack [canvas .c -bg white] -fill both

.c create oval        0   0 100 100 -fill red   -outline black -width 4
.c create rectangle 200 200 300 300 -fill green -outline yellow
.c create line 0  200  200 0 -fill black -width 10
.c create line 0 -200 -200 0 -fill blue  -width 6

set xc 0
set yc 0
focus .c 
bind .c <Button-1>               {set xc %x; set yc %y} 
bind .c <B1-Motion>              {moveItems    %x %y}
bind .c <KeyPress-a>             {scaleItems + %x %y}
bind .c <KeyPress-b>             {scaleItems - %x %y}
bind .c <Control-KeyPress-plus>  {scaleItems + %x %y}
bind .c <Control-KeyPress-minus> {scaleItems - %x %y}

See also Canvas zooming