Produce Thumbnails

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

Category Image Processing