Version 5 of A little image viewer
Updated 2003-04-15 22:14:07
Richard Suchenwirth 2002-09-09 - The evening before a business trip I was told that we'd need to take a viewer for TIFF images with us. A quick search showed that the available ones were not portable, at least not on a floppy, so I decided to roll my own, using the TIFF functionality of Img. Though fitting on a page of code, this cutie has some conveniences: you can scale up or down in powers of two, and either select a file via menu or step through all image files in the current directory. And incidentally: due to the transparent implementation, it can as well handle GIF/PPM/JPEG/PNG/BMP/XBM/XPM images, provided you have the required libs at hand...
escargo 15 Apr 2003 - This a charming application, but (you knew there was going to be a but) the label for the button to zoom out (the minus sign) is really, really small in the font used on my Windows XP (ActiveTcl) 8.4.1 installation (and the jpg file as well). Is there an easy change that would make the zoom in, zoom out more clear to the users?
I also suggest factoring out the lsort [glob ...] so that it will always produce the same result in two different places.
package require Img
set factor 1.0
set files [lsort [glob -nocomplain *.tbg *.tif *.gif *.jpg *.png *.xbm *.xpm]]
proc openImg {w {fn ""}} {
global im1
if {$fn == ""} {
set fn [tk_getOpenFile -filetypes {{"TBG file" .tbg} {"All files" .*}}]
if {$fn !=""} {
cd [file dirname $fn]
set ::files [lsort [glob -nocomplain *.tbg *.tif *.gif *.jpg *.png *.xbm *.xpm]]
}
}
if {$fn != ""} {
wm title . "$fn - tbgview"
catch {image delete $im1}
set im1 [image create photo -file $fn]
scale $w
list [file size $fn] bytes, [image width $im1]x[image height $im1]
}
}
proc scale {w {n 1}} {
global im1 im2 factor
set factor [expr {$factor*$n}]
$w delete img
catch {image delete $im2}
set im2 [image create photo]
if {$factor>=1} {
set f [expr int($factor)]
$im2 copy $im1 -zoom $f $f
} else {
set f [expr round(1./$factor)]
$im2 copy $im1 -subsample $f $f
}
$w create image 1 1 -image $im2 -anchor nw -tag img
$w config -scrollregion [$w bbox all]
}
proc step {w fwd} {
global files
if $fwd {
set first [lindex $files 0]
set files [concat [lrange $files 1 end] [list $first]]
} else {
set first [lindex $files end]
set files [concat [list $first] [lrange $files 0 end-1]]
}
openImg $w $first
}
frame .f
button .f.open -text ... -command {set info [openImg .c]}
button .f.+ -text + -command {scale .c 2}
label .f.f -textvar factor -width 5 -bg white
button .f.- -text - -command {scale .c 0.5}
button .f.< -text < -command {set info [step .c 0]}
button .f.> -text > -command {set info [step .c 1]}
label .f.info -textvar info
eval pack [winfo children .f] -side left -fill y
canvas .c -xscrollcommand ".x set" -yscrollcommand ".y set"
scrollbar .x -ori hori -command ".c xview"
scrollbar .y -ori vert -command ".c yview"
grid .f - -sticky ew
grid .c .y -sticky news
grid .x -sticky ew
grid rowconfig . 1 -weight 1
grid columnconfig . 0 -weight 1
bind . <Escape> {exec wish $argv0 &; exit}
bind . ? {console show}