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[ Category Image Processing ]