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<OriginalName>.<format>"
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