Image scaling

Richard Suchenwirth 2003-02-25 - Photo images 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
 }

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).

EF 18-Jan-2017: For the brave, a variant of the above is the following, which takes any "float" for the scaling factor(s) and computes the ratio of integers. This exhibits the same memory problems as the implementation above, it's just easier to integrate.

proc Double2Fraction { dbl {eps 0.000001}} {
    for {set den 1} {$den<1024} {incr den} {
        set num [expr {round($dbl*$den)}]
        if {abs(double($num)/$den - $dbl) < $eps} break
    }
    list $num $den
}


proc scale {img sx {sy ""} } {
    if { $sx == 1 && ($sy eq "" || $sy == 1) } {
        return;   # Nothing to do!
    }
    
    foreach {sx_m sx_f} [Double2Fraction $sx] break
    if { $sy eq "" } {
        foreach {sy sy_x sy_f} [list $sx $sx_m $sx_f] break;  # Multi-set!
    } else {
        foreach {sy_m sy_f} [Double2Fraction $sy] break
    }
    set tmp [image create photo]
    $tmp copy $img -zoom $sx_m $sy_m -compositingrule set
    $img blank
    $img copy $tmp -shrink -subsample $sx_f $sy_f -compositingrule set
    image delete $tmp
}

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}}

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

Category Image Processing