and here comes my problem, id like my clock to appear on desktop as
digits only, but cant find a way to make label's background transparent
im aware that there are some problems with tk with regard to
transparency (did bit of google search), but i wonder whether its
possible to arrive at solution to this particular problem (doesnt have
to be general, and may include some external libraries, however id like
to stick to tcl)
code goes below
proc every { ms body } {
eval $body
after $ms [list every $ms $body]
}
proc dragStart {windowX windowY} {
set ::DragHoldPosition(x) $windowX
set ::DragHoldPosition(y) $windowY
}
proc dragTo {screenX screenY} {
set positionX [expr { $screenX - $::DragHoldPosition(x) }]
set positionY [expr { $screenY - $::DragHoldPosition(y) }]
wm geometry . [winfo width .]x[winfo height .]+$positionX+$positionY
}
bind . <Button-1> { dragStart %x %y }
bind . <Button1-Motion> { dragTo %X %Y }
bind . <Button-2> { destroy . }
pack [label .lab -textvariable timevar -font "ansi 54 bold" -foreground
#aa66ff]
wm overrideredirect . 1
wm attributes . -alpha 0.5 -topmost 1
every 500 {set ::timevar [clock format [clock sec] -format %H:%M:%S]}
The problem isn't with Tk per se, but that this is inherently something
that isn't easy to do across platforms. There are extensions to Tk for
X11 Shape and Win32 shaped toplevels (tktrans). However, those won't
make what you want easier, because you are intending to change the shape
of the toplevel every second.
This is theoretically possible, but it depends on the platform. I know
how to do it on Win32, but not other platforms.
--
Jeff Hobbs, The Tcl Guy, http://www.activestate.com/
> This is theoretically possible, but it depends on the platform. I know
> how to do it on Win32, but not other platforms.
>
What about using unmanaged/undecorated toplevels for the segments?
withdraw and place as you like it.
Ok, the segments can only be rectangles.
uwe
well i actually want it to run on windows platform (should have
mentioned it earlier, sorry), so if you could elaborate more, and at
last point me in the right direction i would be grateful
> well i actually want it to run on windows platform (should have
> mentioned it earlier, sorry), so if you could elaborate more, and at
> last point me in the right direction i would be grateful
Transparent Toplevel ( for some MS versions):
http://wiki.tcl.tk/10515
you may want to search for more on the wiki:
http://wiki.tcl.tk/2?transpa
http://wiki.tcl.tk/2?transpa*
Lots of fun
uwe
I think the problem with transparent toplevels as implemented in the
core is, whatever alpha you give the toplevel applies to all widgets in
the toplevel. That is, you can't make the toplevel 100% transparent and
have a 100% solid label widget inside.
Too bad. I could find uses for that.
Neat idea! You mean something like this? :
proc drawTransDigit {rootname x y number} {
set ret [list]
if {[string is integer -strict $number] &&
[string length $number] == 1
} {
set segmentList {
a 02356789 10 0 50 10
b 045689 0 10 10 50
c 01234789 60 10 10 50
d 2345689 10 60 50 10
e 0268 0 70 10 50
f 013456789 60 70 10 50
g 0235689 10 120 50 10
}
foreach {segment group x1 y1 width height} $segmentList {
if {[string first $number $group] != -1} {
lappend ret [toplevel $rootname$segment -bg red]
wm attributes $rootname$segment -topmost 1
wm overrideredirect $rootname$segment 1
incr x1 $x
incr y1 $y
wm geometry $rootname$segment ${width}x${height}+${x1}+${y1}
}
}
}
return $ret
}
proc drawTransNumber {rootname x y number} {
set ret [list]
foreach i [split $number {}] {
set ret [concat $ret [drawTransDigit $rootname$x $x $y $i]]
incr x 100
}
return $ret
}
# Test:
set foo [drawTransNumber .test 10 10 12345]
# To delete do:
# foreach x $foo {destroy $x}
Look for how SetLayeredWindowAttributes is called in tk/win/tkWinWm.c.
Instead of LWA_ALPHA, if you use LWA_COLORKEY and specify an RGB color
that should be transparent, then you could do essentially what you want.
Combine it with a wm overrideredirect window, making it white where
white is the transparent color, anything you draw on that will be all
that you should see. More info at:
Working code - this works on my sample of one (XP SP2). Note to drag
the clock around you have to click the mouse on an opaque area.
package require Tk
package require twapi 1.1
proc every { ms body } {
eval $body
after $ms [list every $ms $body]
}
proc dragStart {windowX windowY} {
set ::DragHoldPosition(x) $windowX
set ::DragHoldPosition(y) $windowY
}
proc dragTo {screenX screenY} {
set positionX [expr { $screenX - $::DragHoldPosition(x) }]
set positionY [expr { $screenY - $::DragHoldPosition(y) }]
wm geometry . [winfo width .]x[winfo height .]+$positionX+$positionY
}
bind . <Button-1> { dragStart %x %y }
bind . <Button1-Motion> { dragTo %X %Y }
bind . <Button-2> { destroy . }
pack [label .lab -textvariable timevar -font "ansi 54 bold" -foreground
\#aa66ff -background red]
every 500 {set ::timevar [clock format [clock sec] -format %H:%M:%S]}
wm overrideredirect . 1
wm attributes . -topmost 1
# For some reason, we cannot change style bits until window is
visible/mapped
update idletasks
# Get the parent of the Tk toplevel - this is the real toplevel from
# the Windows perspective
set top_id [twapi::get_parent_window [winfo id .]]
# Set its style bits to allow layering
foreach {style exstyle} [twapi::get_window_style $top_id] break
twapi::set_window_style $top_id $style [expr {0x80000+$exstyle}]
# Set transparency color (red is 0x0000ff as per Windows COLORREF
struct
::twapi::SetLayeredWindowAttributes $top_id 0xff 255 1
/Ashok
Jeff Hobbs wrote:
>
> Look for how SetLayeredWindowAttributes is called in tk/win/tkWinWm.c.
> Instead of LWA_ALPHA, if you use LWA_COLORKEY and specify an RGB color
> that should be transparent, then you could do essentially what you want.
> Combine it with a wm overrideredirect window, making it white where
> white is the transparent color, anything you draw on that will be all
> that you should see. More info at:
very nice,
the "-topmost" option to [wm attributes] breaks on X11.
everything being indented at least one space sugests
you have already put it on the wiki?
uwe
Sorry about that. It will also break on Macs. Should have done a
platform check but this was a quick and dirty hack.
> everything being indented at least one space sugests
> you have already put it on the wiki?
>
No, it's not on the wiki yet. It's just how I format my code for usenet
(just a single step in my editor: replace all \t with two spaces). I'll
put it up later. To closer meet the OP's original requirement add this:
array set foo {
h {} m {} s {}
H 0 M 0 S 0
}
proc tick {} {
global foo
after 1000 tick
set now [clock seconds]
set now [clock format $now -format "%I.%M.%S"]
foreach {H M S} [split $now .] break
# The code can indeed be simpler than this
# but the simple version flickers too much
# for my tastes. All this voodoo is merely
# to reduce flicker:
if {$H != $foo(H)} {
set foo(H) $H
foreach x $foo(h) {destroy $x}
set foo(h) [drawTransNumber .trans 10 10 $H]
}
if {$M != $foo(M)} {
set foo(M) $M
foreach x $foo(m) {destroy $x}
set foo(m) [drawTransNumber .trans 240 10 $M]
}
if {$S != $foo(S)} {
set foo(S) $S
foreach x $foo(s) {destroy $x}
set foo(s) [drawTransNumber .trans 470 10 $S]
}
}
tick
# To allow us to easily kill this beast:
pack [button .exit -command exit -text Exit]
You will also find this in 8.5 as
wm attributes $win -transparentcolor ?color?
for Windows. It doesn't appear that X11 or Aqua have this feature, so
don't expect to see it anywhere else.
--
Jeff Hobbs wrote:
> You will also find this in 8.5 as
> wm attributes $win -transparentcolor ?color?
> for Windows. It doesn't appear that X11 or Aqua have this feature, so
> don't expect to see it anywhere else.
While Aqua does not have exactly this feature, of course CG has full
RGBA support, so it is perfecly possible to have a fully transparent
window without titlebar (i.e. an overrideredirect filled with a fully
transparent color) and then draw some more or less transparent content
drawn onto it.
However, integrating the CG model fully with Tk would require support
for alpha in Tk throughout (and probably factoring out of many of the
"erase before drawing" assumptions from X11), not exactly a short term
project ;-)
Cheers,
Daniel