2005 update edit

 # Description: This creates a small window demonstrating toplevel transparency in Windows XP, 2000, and Mac OS X.
 # Author: Paul Walton

 # Show the console when ctrl+c is pressed.
 bind . <Control-c> { catch {console show} }

 # Enable window dragging.
 bind . <Button-1> { if {"%W" == "."} {dragStart %x %y} }
 bind . <Button1-Motion> { if {"%W" == "."} {dragTo %X %Y} }

 # Enable automatic fading/unfading when the mouse enters or leaves the main window.
 bind . <Leave> { if {"%W" == "."} {fade start} }
 bind . <Enter> { if {"%W" == "."} {unfade start} }




 # Define some aspects of the main window.
 wm overrideredirect . 1
 wm geometry . 400x200
 wm attributes . -alpha .65 -topmost 1


 # Global variable that is linked with the scale widget and contains the current alpha level of the main window
 set AlphaLevel 0.65

 # Global variables that are booleans specifing whether the window should currently be fading in or out.
 set Fading 0
 set Unfading 0



 # Create small "X" to close the window with.
 pack [button .close -text "x" -command {destroy .} -relief flat -overrelief groove] -padx 10 -side top -anchor w

 # Create a slider bar with the scale widget to adjust the transparency.
 pack [scale .adjust -from 1.0 -to 0.02 -resolution 0.01 -variable AlphaLevel -command {wm attributes . -alpha}] -side top




 proc dragStart {windowX windowY} {
        # This sets the anchor point for dragging the window with the cursor.
        # This should be called whenever the left mouse button is pressed on the window.

        set ::DragHoldPosition(x) $windowX
        set ::DragHoldPosition(y) $windowY
 }

 proc dragTo {screenX screenY} {
        # This positions the window to the new coordinates, giving a dragging effect.
        # This should be called whenever there is mouse motion while the left mouse button is pressed down.

        set positionX [expr { $screenX - $::DragHoldPosition(x) }]
        set positionY [expr { $screenY - $::DragHoldPosition(y) }]

        wm geometry . [winfo width .]x[winfo height .]+$positionX+$positionY
 }




 proc fade {mode} {
        # This slowly fades the window until it is barely visible.
        # This proc should be called whenever the mouse leaves the main window.
        # The fading effect stops if the mouse re-enters the window.

        global Fading AlphaLevel


        switch -- $mode {
                start {
                        # Make sure that unfading is stopped.
                        unfade stop
                        # Set the fading flag.
                        set Fading 1
                        fade more
                }
                stop {
                        set Fading 0
                        return
                }
                more {
                        if { $Fading == 0 } {
                                # Fading has been stopped.
                                return
                        }
                }
                default {
                        return
                }
        }

        # Get the level of transparency of the window (0 to 1.0).
        set alphaLevel [wm attributes . -alpha]

        # Check if the window has faded enough.
        if { $alphaLevel <= .20 } {
                # The window has faded enough.
                set Fading 0
        } else {
                # Fade the window some more.
                wm attributes . -alpha [expr {$alphaLevel - 0.025} ]
                set AlphaLevel [wm attributes . -alpha]
                after 100 fade more
        }

        return
 }



 proc unfade {mode} {
        # This slowly unfades the window until it is visible enough.
        # This proc should be called whenever the mouse enters the main window.
        # The unfading effect stops if the mouse exit the window.

        global Unfading AlphaLevel


        switch -- $mode {
                start {
                        # Make sure fading is stopped.
                        fade stop
                        # Set the unfading flag.
                        set Unfading 1
                        unfade more
                }
                stop {
                        set Unfading 0
                        return
                }
                more {
                        if { $Unfading == 0 } {
                                # Unfading has been stopped.
                                return
                        }
                }
                default {
                        return
                }
        }

        # Get the level of transparency of the window (0 to 1.0).
        set alphaLevel [wm attributes . -alpha]

        # Check if the window has unfaded enough.
        if { $alphaLevel >= 0.90 } {
                # The window has unfaded enough.
                set Unfading 0
        } else {
                # Unfade the window some more.
                wm attributes . -alpha [expr {$alphaLevel + 0.05} ]
                set AlphaLevel [wm attributes . -alpha]
                after 100 unfade more
        }

        return
 }

Simulating transparent toplevels edit

• Only works on windows (unix/mac code would be welcome)
• Assumes scaled wallpaper (you can check the WallpaperTile value to see if it's actually tiled, and possibly other registry settings - I'll leave that as an exercise...)
• Only scales the image by integer amounts - this is a limitation of Tk's image scaling code.
• You have to pack child widgets into $path.c - the canvas. You could use snit or some other code to make this more transparent (pun intended).

 # Creates a "transparent" window on windows...
 package require Tk
 package require registry
 package require Img

 proc transtop {path args} {
     uplevel 1 [list toplevel $path] $args
     # Create a canvas in this toplevel
     pack [canvas $path.c] -fill both -expand 1
     # Find out the desktop wallpaper image
     set file [registry get HKEY_CURRENT_USER\\Control\ Panel\\Desktop \
         Wallpaper]
     set im [image create photo -file [file normalize $file]]
     set bg [image create photo]
     set scalex [expr {int(double([winfo screenwidth $path]) /
                 double([image width $im]) + 0.9)}]
     set scaley [expr {int(double([winfo screenheight $path]) /
                 double([image height $im]) + 0.9)}]
     $bg copy $im -zoom $scalex $scaley
     set id [$path.c create image 0 0 -anchor nw -image $bg]
     updateBgImage $path.c $id
     bind $path <Configure> [list updateBgImage $path.c $id]

     return $path
 }

 proc updateBgImage {c id} {
     set x [expr {0 - [winfo rootx $c]}]
     set y [expr {0 - [winfo rooty $c]}]
     $c coords $id $x $y
 }

 if {$argv0 eq [info script]} {
     # Main
     transtop .t
     bind .t <Destroy> { exit }
     wm withdraw .
 }

 package require cwind
 ::cwind::send |SNAP|

 package req Tk
 pack [label .t -font {Helvetica 24} -text "Hello, world"]
 for {set i 20} {$i>=0} {incr i -1} {
    wm attributes . -alpha [expr $i/20.]
    if {$i==19} update
    after 250
 }
 for {set i 1} {$i<=20} {incr i} {
    wm attributes . -alpha [expr $i/20.]
    after 250
 }

 proc fade {win {final 0.0} {step 0.2}} {
     set alpha [wm attributes $win -alpha]
     if {$alpha == $final} { return }
     wm attribute $win -alpha [expr {$alpha-$step}]
     after 50 [info level 0]
 }

 if {abs($alpha-$final) < abs($step)} { wm attributes $win -alpha $final; return }

• Home
• Recent changes
• Help
• WhoAmI/Logout
• Create new page
• Random page
• Previous page
• Next page
• 
  
• Add comments
• Edit
• History
• Edit summary
• References