[http://mini.net/files/tbgview.jpg]
----
[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 handle GIF/PPM/JPEG/PNG/BMP images, provided you have the required libs at hand...
----
 package require Img
 set factor 1.0
 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]]
	}
    }
    if {$fn != ""} {
	wm title . "$fn - tbgview"
	catch {image delete $im1}
	set im1 [image create photo -file $fn]
	scale $w 1
    }
 }
 proc scale {w n} {
	global im1 im2 factor
	set factor [expr {$factor*$n}]
	$w delete img
	catch {delete image $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 {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 {step .c 0}
 button .f.> -text > -command {step .c 1}
 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}
----
[Arts and crafts of Tcl-Tk programming]