Version 6 of Transparent Toplevel

Updated 2003-12-07 00:29:35

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...

FW: It's compiled, for Windows. Any #FF00FF pixel is made transparent, so you can make nonstandardly shaped windows. I've also just noticed DKF's new extension Shape, however, which has a less trivial code but supports Windows and X (and maybe eventually Mac OSes) and doesn't forbid you from using a shade of bright purple in your applications ;) This one's a really clever idea, but I still don't think it has an application, as a good amount of people won't just have the desktop behind the window.

GS (031206) Is there a way to save a screenshot in a file from the clipboard ? If it is possible, we can use the cwind package do a snapshot of the desktop with:

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

And after we can put the file into the canvas.

I have made a test by hand saving the image desktop with MsPaint. The result is funny.