2005 update: At least in version 8.4.11, you can have transparent toplevels in Windows XP, Windows 2000, and Mac OS X with the wm attributes command. Here´s an example I made that demonstrates a transparent toplevel window:
# 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> {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}
The rest of this page is at least two years old. -Paul Walton
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:
# 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.