Version 3 of Image Fading

Updated 2007-09-11 15:45:28 by kpv

Keith Vetter 2007-09-10 : One cute effect I've always wanted to do was to fade one image into another. Unfortunately, tcl's image handling abilities are not one of its strong points, and the straight-forward method for fading is too slow for this.

But then I thought of a clever hack of exploiting the -alpha attribute of a toplevel window. Place two toplevels exactly on top of each other, each displaying a different image, and vary the first one's alpha value from 0 to 1 while varying the second ones from 1 to 0. (It turns out you also need a third toplevel with a neutral background under everything to keep the desktop from peeking through.)

Nice little hack. It would be harder, but not impossible, to generalize to non-trivial situations.

Note, my display flickers as you move the scale--not sure if it's my machine or an OS problem.

JAG, 11-Sep-2007 - Keith, that's a pretty neat hack - nicely done. FYI, running on WinXP-Pro the fade seems pretty smooth, though I do get an occasional odd "flash" in the display. KPV yep, that's what I get.

David Easton, 11-Sep-2007 - Can't you do this with just the 2 images if the background image is kept opaque and the front image varies from 0 to 1?

KPV - You're probably right. Just tried it out (simply comment out the alpha setting for window .t1) and looks about the same. However, my approach is probably a bit simpler if I were to extend this so that it can fade between a series of images.


 ##+##########################################################################
 #
 # ImageFade.tcl -- hack to get two images fading into one another
 # by Keith Vetter, September 2007
 #

 package require Tk

 set S(title) "Image Fading"
 set S(perc) 100

 # Idir is the tk demo directory
 set idir [file join $::tk_library .. .. demos Tk[info tclversion] images]

 proc DoDisplay {} {
    global S

    wm withdraw .
    foreach id {0 1 2} {
        set w .t$id
        toplevel .$w
        label $w.l -image ::img::img$id
        pack $w.l -side top -fill both -expand 1
        wm protocol $w WM_DELETE_WINDOW exit
        wm resizable $w 0 0
        wm title $w "Image \#$id"
        wm geom $w +10+10
        raise $w
        if {$id == 0} {
            scale $w.s -from -100 -to 100 -orient h -variable S(perc)
            pack $w.s -side bottom -expand 1
            wm title $w $::S(title)
        } else {
            wm transient $w .t0
        }
    }
    foreach t [trace info variable S(perc)] {
        eval trace remove variable S(perc) $t
    }
    trace variable S(perc) w Tracer
    update
    bind .t2 <Configure> {WindowMove}
 }
 ##+##########################################################################
 # 
 # Grabs two images from the tk demo directory
 # 
 proc FindPhotos {} {
    global idir

    set img1 [file join $idir earth.gif]
    set img2 [file join $idir earthris.gif]
    if {! [file exists $img1]} {
        set idir2 [file nativename [file normalize $idir]]
        set msg "Cannot find tk demo images\nearth.gif and earthris.gif."
        append msg "\n\nLooking in:\n  $idir2"
        tk_messageBox -icon error -message $msg -title "Error"
        exit
    }

    image create photo ::img::img1 -file $img1
    image create photo ::img::img2 -file $img2
    image create photo ::img::img0 \
        -width [image width ::img::img1] -height [image height ::img::img1]
 }
 ##+##########################################################################
 # 
 # We want to make sure that our 3 windows stay in sync with
 # each other when the top one moves.
 # 
 proc WindowMove {} {
    set pos "+[winfo x .t2]+[winfo y .t2]"
    wm geom .t0 $pos
    wm geom .t1 $pos
 }
 proc Tracer {var1 var2 op} {
    global S

    set alpha2 [expr {($S(perc)+100)/200.0}]    ;# Convert -100-100 to 0-1.0
    set alpha1 [expr {1 - $alpha2}]
    wm attribute .t1 -alpha $alpha1
    wm attribute .t2 -alpha $alpha2
    update
 }
 FindPhotos
 DoDisplay 
 return

Category ???