Here is an alternative implementation to Canvas Zooming.
This version supports zooming under the pointer using mousewheel events.
Error accumulation in text strings is avoided by storing the original text and fontsize in tags. Text that is zoomed below a minimum size is hidden until zoomed back out again.
It would be nicer if text items were allowed fractional point sizes.
(Apparently the font API changed in the last 10 years or so... fixed bug with setting font size 10/14/2009 )
Contributed by: JCE
proc zoominit {c {zfact {1.1}}} {
# save zoom state in a global variable with the same name as the canvas handle
upvar #0 $c data
set data(zdepth) 1.0
set data(idle) {}
# add mousewheel bindings to canvas
bind $c <Button-4> "zoom $c $zfact"
bind $c <Button-5> "zoom $c [expr {1.0/$zfact}]"
bind $c <MouseWheel> "if {%D > 0} {zoom $c $zfact} else {zoom $c [expr {1.0/$zfact}]}"
}
proc zoom {c fact} {
upvar #0 $c data
# zoom at the current mouse position
set x [$c canvasx [expr {[winfo pointerx $c] - [winfo rootx $c]}]]
set y [$c canvasy [expr {[winfo pointery $c] - [winfo rooty $c]}]]
$c scale all $x $y $fact $fact
# save new zoom depth
set data(zdepth) [expr {$data(zdepth) * $fact}]
# update fonts only after main zoom activity has ceased
after cancel $data(idle)
set data(idle) [after idle "zoomtext $c"]
}
proc zoomtext {c} {
upvar #0 $c data
# adjust fonts
foreach {i} [$c find all] {
if { ! [string equal [$c type $i] text]} {continue}
set fontsize 0
# get original fontsize and text from tags
# if they were previously recorded
foreach {tag} [$c gettags $i] {
scan $tag {_f%d} fontsize
scan $tag "_t%\[^\0\]" text
}
# if not, then record current fontsize and text
# and use them
set font [$c itemcget $i -font]
if {!$fontsize} {
set text [$c itemcget $i -text]
if {[llength $font] < 2} {
#new font API
set fontsize [font actual $font -size]
} {
#old font API
set fontsize [lindex $font 1]
}
$c addtag _f$fontsize withtag $i
$c addtag _t$text withtag $i
}
# scale font
set newsize [expr {int($fontsize * $data(zdepth))}]
if {abs($newsize) >= 4} {
if {[llength $font] < 2} {
#new font api
font configure $font -size $newsize
} {
#old font api
set font [lreplace $font 1 1 $newsize] ; # Save modified font! [ljl]
}
$c itemconfigure $i -font $font -text $text
} {
# suppress text if too small
$c itemconfigure $i -text {}
}
}
# update canvas scrollregion
set bbox [$c bbox all]
if {[llength $bbox]} {
$c configure -scrollregion $bbox
} {
$c configure -scrollregion [list -4 -4 \
[expr {[winfo width $c]-4}] \
[expr {[winfo height $c]-4}]]
}
}
# test code
set f [font create -family sans] ; # use private font instance to avoid modifying font outside of this canvas [JCE]
pack [canvas .c] -expand true -fill both
zoominit .c
.c create text 50 50 -text "Hello, World!" -font $f ; # use private font instance [JCE]
.c create rect [.c bbox all]Schnexel This is useless if you want to keep (halfways) control over them coordinates. With
$c scale all $x $y $fact $fact
you manipulate them in a non-reversible manner, when $x $y are varying.
Tcl/Tk can change floating point numbers even if you just copy them around the canvas (e.g. splitting 1 line in 2), even with ::tcl_precision 17... (eek! forget nontrivial graphical numerics with Tcl/Tk...). Nevertheless, here´s how I keep the coordinates "constant" modulo zoom factor:
# zoom at the current mouse position
set xx [expr {[winfo pointerx $c] - [winfo rootx $c]}] ;# $xx is bind´s %x
set yy [expr {[winfo pointery $c] - [winfo rooty $c]}]
set canvX [expr {[$c canvasx $xx]*$fact}]
set canvY [expr {[$c canvasy $yy]*$fact}]
$c scale all 0 0 $fact $fact
set bbox [$c bbox all]
$c configure -scrollregion $bbox
set mx [expr ($canvX-$xx-[lindex $bbox 0]+1.0)/([lindex $bbox 2]-[lindex $bbox 0])]
set my [expr ($canvY-$yy-[lindex $bbox 1]+1.0)/([lindex $bbox 3]-[lindex $bbox 1])]
if { $mx<0.0 } { set mx 0.0 } elseif { $mx>1.0 } { set mx 1.0 }
if { $my<0.0 } { set my 0.0 } elseif { $my>1.0 } { set my 1.0 }
$c xview moveto $mx
$c yview moveto $myIt's an adaption from my code, I have not tested it with the above (no time & no mousewheel). Note the +1.0, it's to avoid zoom-drifting.
JCE - 2009-10-14 11:35:50
I don't understand Schnexel's comment.
I have tested my code and (after fixing for changes to the font API that happened sometime in the last 10 years) it still works for me.
None of the x,y coordinates in the canvas are changed by the zooming operation, so there is no accumulation of errors.
APE - 2020-03-02 Maybe Schnexel's comment is about adding new items on the canvas or moving them, thus being allowed to control transformation on the coordinates in the scaled canvas. Using scale origin at "0 0" you can then add new items just by applying accumulated zoom factor to the new item coordinates to display it properly in the canvas.
ljl Fixed minor issue with saving font for old API
JCE - 2010-10-21 11:31:00
Modified to use a private font instance in the test case. This avoids changing the fontsize outside of this canvas when used as part of a larger GUI.