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}Chris L (11/08/2004) Just discovered this whilst investigating something else... Anyway, as it stands, if you change direction as you cycle through the images, the first movement in the new direction doesn't happen. In the extreme case, you can click left, right, left, right and never go anywhere. I changed 'step', and added a current position and file count to fix it:-
set currentImg 0
set filecount [llength $files]
proc step {w fwd} {
global files currentImg filecount
global files currentImg filecount
set currentImg [expr {($currentImg + ($fwd ? 1 : -1)) % $filecount}]
set currentImg [expr {($currentImg + ($fwd ? 1 : -1)) % $filecount}]
openImg $w [lindex $files $currentImg]
}For the pocket edition, see imgview as eTcl plugin
HoMi-(2008-12-01) Sorry Chris, but your "solution" produces an "Division by zero" error any time the proc 'step' is called. The reason therefore is that it determines the length of the list of files at startup time of the script and at this time the list length is always null.But btw. there is no need to implement an image counter or anything else. Richards original step proc was the right way. This proc has only one little error, that is that this proc determines the first element of the files list before it makes the list rotation. By changing the last line of the original proc from
openImg $w $firstto
openImg $w [lindex $files 0]the proc works always correct in any cycle direction.
mwilhelmy 2012-08-17Based on the code above, I wrote uiv
, a small image viewer.