Version 4 of Merging images with transparency

Updated 2003-09-28 17:15:34

ulis, 2003-09-28.

---

Please, download the images file before running the script:

  http://perso.wanadoo.fr/maurice.ulis/tcl/flower1.gif
  http://perso.wanadoo.fr/maurice.ulis/tcl/flower2.gif

---

  # parameters of 1st image
  set file1 flower1.gif
  # parameters of 2nd image
  set file2 flower2.gif
  set dx 0        ;# x displacement
  set dy 0        ;# y displacement
  set alpha 0.25  ;# opacity
  if {$alpha < 0.0 || $alpha > 1.0} \
  { error "alpha should be between 0.0 and 1.0" }
  # package
  package require Tk
  # merge proc
  proc merge {img1 img2 dx dy alpha} \
  {
    # compute alpha factors
    set a2 $alpha
    set a1 [expr {1.0 - $a2}]
    # get images sizes
    set width1 [image width $img1]
    set height1 [image height $img1]
    set width2 [image width $img2]
    set height2 [image height $img2]
    # merge the pixels
    set x1 $dx
    set x2 0
    for {set i 0} {$i < $width1} {incr i} \
    {
      if {$i > $width2} { break }
      set y1 $dy
      set y2 0
      for {set j 0} {$j < $height1} {incr j} \
      {
        if {$j > $height2} { break }
        # skip if pixel is transparent
        if {![$img2 transparency get $x2 $y2]} \
        {
          # merge each color component
          foreach {R G B} [$img1 get $x1 $y1] break
          foreach {_R _G _B} [$img2 get $x2 $y2] break
          foreach c {R G B} \
          {
            set c2 [set _$c]
            set c1 [set $c]
            set $c [expr {round($c1 * $a1 + $c2 * $a2)}]
          }
          # update the image
          set color [format #%02x%02x%02x $R $G $B]
          $img1 put $color -to $x1 $y1
        }
        incr y1
        incr y2
      }
      incr x1
      incr x2
    }
  }
  # create images
  image create photo _img1_ -file $file1
  image create photo _img2_ -file $file2
  # merge images
  merge _img1_ _img2_ $dx $dy $alpha
  # display result
  pack [canvas .c]
  .c create image 0 0 -anchor nw -image _img1_

---

Category Example