[MG] - 26th March 2004. A fairly simple proc which takes an image, and creates a 'thumbnail' of it (a smaller version of the image), anything from 2 (a half) to 20 times smaller. It's fairly crude, but it works :) Allows you to save as either a GIF, JPEG or BMP file (although it can open any of the types of image which the [Img] extension, which is required, can recognise). There's absolutely no reason it couldn't be extended to support other formats with minimal effort, though. package require Img set types { {{All Images} {.gif} {}} {{All Images} {.jpeg} {}} {{All Images} {.jpg} {}} {{All Images} {.bmp} {}} {{All Images} {.tiff} {}} {{All Images} {.png} {}} {{All Files} {.*} {}} {{Gif Images} {.gif} {}} {{Jpeg Images} {.jpg} {}} {{Jpeg Images} {.jpeg} {}} {{Bitmap Images} {.bmp} {}} {{Tiff Images} {.tiff} {}} {{PNG Images} {.png} {}} } set text "Select how many times smaller to make the image in the spinbox. " append text "Type the name of the file into the field, or click 'Browse' and select it. " append text "Choose the format you want to save in at the bottom, and then click 'Go'. " append text "The new image will be called THUMB." label .l -text $text -wrap 250p pack .l -side top -padx 2 -pady 4 frame .f pack .f -side top -pady 4 entry .f.e -width 40 -textvariable ::filename button .f.b -text "Browse..." -command "browseFile" pack .f.e .f.b -side left -padx 3 frame .f2 pack .f2 -side top -pady 4 label .f2.l -text "Shrink Image " spinbox .f2.sb -from 2 -to 20 -textvariable ::shrinkby label .f2.l2 -text " Times" pack .f2.l .f2.sb .f2.l2 -side left -padx 1 labelframe .f3 -text "Output Format: " -labelanchor nw pack .f3 -side top -pady 4 radiobutton .f3.r1 -value gif -variable ::outtype -text "Gif" radiobutton .f3.r2 -value jpeg -variable ::outtype -text "Jpeg" radiobutton .f3.r3 -value bmp -variable ::outtype -text "Bitmap" pack .f3.r1 .f3.r2 .f3.r3 -side top -pady 2 -padx 2 button .f.go -text "Produce Thumbnail" -command {doThumb} pack .f.go -side top -anchor center -padx 4 -pady 5 proc doThumb {} { global outtype filename shrinkby if { ![file exists $filename] || ![file isfile $filename] } { tk_messageBox -icon error -title Thumbnail -message "Invalid file \"$filename\"" return; } if { [catch {image create photo original -file $filename}] } { tk_messageBox -icon error -title Thumbnail -message "That is not a valid image file." return; } image create photo newimg newimg copy original -subsample $shrinkby $shrinkby set newFile [file join [file dirname $filename] "THUMB[file tail [file rootname $filename]].$outtype"] newimg write $newFile -format $outtype if { [file exists $newFile] } { tk_messageBox -title Thumbnail -message "Thumbnail created successfully at \"[file normalize [file nativename $newFile]]\"" exit; } else { tk_messageBox -title "Thumbnail" -message "Error creating image file at \"[file normalize [file nativename $newFile]]\"" catch {image delete original newimg} } };# doThumb proc browseFile {} { set newfile [tk_getOpenFile -filetypes $::types -initialdir ~/windows/desktop] if { $newfile != "" } { global filename set filename [file nativename [file normalize $newfile]] } };# browseFile ---- [[ [Category Image Processing] ]]