[Richard Suchenwirth] 2003-02-25 - [Photo] [image]s can be resized by adding the -zoom or -subsample switches when copying an image. Here is a wrapper that takes only a factor and selects the appropriate switch. The image is scaled in place (so when it is displayed in a widget, updating goes automatically), the temporary image t is freed when no more needed. The following enhanced version is 3 LOC more, but also does flipping around x and/or y axis:
proc scaleImage {im xfactor {yfactor 0}} {
set mode -subsample
if {abs($xfactor) < 1} {
set xfactor [expr round(1./$xfactor)]
} elseif {$xfactor>=0 && $yfactor>=0} {
set mode -zoom
}
if {$yfactor == 0} {set yfactor $xfactor}
set t [image create photo]
$t copy $im
$im blank
$im copy $t -shrink $mode $xfactor $yfactor
image delete $t
}
[WikiDbImage ifilezoom.jpg]
Usage examples: adding the following lines gives [iFile: a little file system browser] scaling capacities on the image shown on the "File" page:
.m add casc -label Image -menu [menu .m.image -tearoff 0]
.m.image add comm -label "Zoom x 3" -command {scaleImage $g(i) 3}
.m.image add comm -label "Zoom x 2" -command {scaleImage $g(i) 2}
.m.image add comm -label "Zoom x 0.5" -command {scaleImage $g(i) 0.5}
.m.image add comm -label "Zoom x 0.33" -command {scaleImage $g(i) 0.33}
.m.image add separator
.m.image add comm -label "Flip LR" -command {scaleImage $g(i) -1 1}
.m.image add comm -label "Flip TB" -command {scaleImage $g(i) 1 -1}
.m.image add comm -label "Flip both" -command {scaleImage $g(i) -1 -1}
For robustness, one might disable this menu when no image is displayed. Experience shows that enlarging bigger photo images may let the little machine run out of memory - time to throw away some fat MP3 files...
----
[dzach] 16-Sep-2005: Following a suggestion of [suchenwi] in the ''Tcler's chat'', here is a proc to uniformly scale an image in place, using a ratio of integers r1/r2:
proc ratscale {img r1 r2} {
image create photo tmp_img
tmp_img copy $img -zoom $r1
$img blank
$img copy tmp_img -subsample $r2
image delete tmp_img
}
However for large rationals (say 200/255) this may be a memory killer, since it will first zoom the image by 200 and then subsample it (1 every 255).
----
Image scaling also helps in the GIF transparency problem on [iPAQ] - this workaround works:
* put an instance of the image in a widget (e.g. a [text])
* zoom up
* subsample down again
Now transparent pixels are in the widget background color (white), no more random and black, for all instances, and certainly look better than before.
foreach i $g(images) {
$g(text) image create end -image $g($i)
scaleImage $g($i) 3
scaleImage $g($i) .33
}
----
[RS] 2006-02-13: Here's a variation that takes an image and a percentage (see [Greatest common denominator] for gcd), and returns an accordingly scaled image:
proc image% {image percent} {
set deno [gcd $percent 100]
set zoom [expr {$percent/$deno}]
set subsample [expr {100/$deno}]
set im1 [image create photo]
$im1 copy $image -zoom $zoom
set im2 [image create photo]
$im2 copy $im1 -subsample $subsample
image delete $im1
set im2
}
proc gcd {u v} {expr {$u? [gcd [expr $v%$u] $u]: $v}}
----
See also [Photo image rotation], [Shrinking an image]
For fast arbitrary rotation (and scaling) see: [Enhanced photo image copy command]
----
The combination of photo image zooming and the [Img] extension let
us code [A little magnifying glass] in just a few lines.
----
[hypnotoad] Has a C based Tk Image scaler that works with arbitrary sizes: [Image Scaling in C]----
[CatSegory Image Procealssing]o | [Arts and crafts of Tcl-Tk programming]
<<categories>> Image Processing