Version 4 of Transparent Toplevel

Updated 2003-12-06 15:59:26

Someone was enquiring on the Tcl'ers Chat if Tk could do transparent toplevels. It can't natively, but you can simulate them using a canvas. Here is some code which should work on Microsoft Windows systems. It simply gets the wallpaper picture by querying the registry, and then draws the appropriate part of it as a background on the canvas. There are some problems, which should be addressed:

  • 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 (no 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 .
 }

FW notes this is by Neil Madden, who seems to have forgotten to ;) And also notes that TkTrans is the standard full implementation.

NEM D'oh! Yes, it is by me. Is TkTrans a compiled extension, or pure Tcl code? Either way, if you can use it instead of this code, I would. Note also, that using transparency in an application is likely to be a hideous usability error. Having a semi-transparent background would probably be better. Also, note that if you pack other widgets (text widgets, buttons, labels etc) onto the canvas, they will not be transparent...