[MG] - March 26th 2004. A small proc which turns every pixel in a [photo] image which matches a color of your choice to transparency. It uses the [Img] package, and saves the image in the same format, by default (although, if you're editing a bitmap or something, an option to save as a GIF or PNG instead would probably be useful). Only tested on Windows (98 and XP), though I don't see any reason why it wouldn't work on other platforms. The 'GUI' - and I use the term loosely - could use some sprucing up, but I just whipped this up quickly and couldn't be bothered improving it, at the time; if someone wants to, feel free. This is rather slow for large images, but it's the only way I can find to do this in Tcl :) ''[MG] March 1st 2007 - The above actually wasn't true - it always outputted as a GIF. Modified now to always output as a PNG, as that seems the most useful format, as it doesn't throw an error when used on a file with more than 256 colors. Thanks to Rich for pointing out the error.'' ====== 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 "Type the name of the file into the field, or click 'Browse' and select it. " append text "Click the button to select which color to make transparent. " append text "ALL pixels in the image in this color will be made transparent. " append text "The new image will be called TRANS. " append text "(note: this may take some time to run for large images)" label .l -text $text -wrap 400p 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 frame .f3 pack .f3 -side top -pady 4 set color2use "white" button .f3.b -text "Change Color..." -command {setColor} label .f3.l -text "Example:" button .f3.ex -background $color2use -width 5 bindtags .f3.ex {} pack .f3.b .f3.l .f3.ex -side left -padx 4 frame .f4 pack .f4 -side top -pady 4 button .f4.b -text "Go!" -command recolImage pack .f4.b proc recolImage {} { global filename color2use if { ![file exists $filename] || ![file isfile $filename] } { tk_messageBox -message "Invalid file \"$filename\"" return; } if { [catch {image create photo original -file $filename}] } { tk_messageBox -message "Invalid image." return; } if { [catch {winfo rgb . $color2use} rgb] } { tk_messageBox -message "Invalid color \"$color2use\"" return; } set rgb2 [list [expr [lindex $rgb 0]/256] [expr [lindex $rgb 1]/256] [expr [lindex $rgb 2]/256]] set h [image height original] ; set w [image width original] for { set x 0 } {$x < $w} {incr x} { for {set y 0} {$y < $h} {incr y} { puts "COORDS: $x $y" update if { [original get $x $y] == $rgb2 } { original transparency set $x $y 1 } } } set newFile [file join [file dirname $filename] "TRANS[file rootname [file tail $filename]].png"] original write $newFile -format png if { [file exists $newFile] } { tk_messageBox -title Transparency -message "Transparency created successfully at \"[file normalize [file nativename $newFile]]\"" exit; } else { tk_messageBox -title "Transparency" -message "Error creating image file at \"[file normalize [file nativename $newFile]]\"" catch {image delete original} } };# recolImage proc setColor {} { global color2use set newcol [tk_chooseColor -title "Select Color" -initialcolor $color2use] if { $newcol != "" } { set color2use $newcol } .f3.ex configure -bg $color2use };# setColor proc browseFile {} { set newfile [tk_getOpenFile -filetypes $::types -initialdir ~/windows/desktop] if { $newfile != "" } { global filename set filename [file nativename [file normalize $newfile]] } };# browseFile catch {console show} ====== ---- [TS] Google for "giftool" or "giftrans" if you need faster tools for GIFs. ---- [RS] 2006-01-11 did not know this page, but had a similar requirement - here's what I did: ====== proc transparent {image color} { set r -1 foreach row [$image data] { incr r set c -1 foreach col $row { incr c if {$col eq $color} {$image transparency set $c $r 1} } } } ====== However, even though I did nothing time-consuming (like [update] or [puts] further above), the timing behavior is still frustrating: for a black/white image of 624*228, it took over 20 seconds to march through it :( ---- [Kroc] - Another quick and dirty way to do it in one line : image create photo transp -data [string map {"c #ffffff" "c None"} [$image data -format XPM]] <> Graphics | Image Processing