HoMi-(2008-12-04) Hereby I will follow the appeal of [slebetman] and provide the flickerfree version of his wonderful transparent digital clock. The problem in the original code was that the segments of both digits of the seconds value were destroyed, and after this the required segments of both digits for the new value were created. This means the tens digit was destroyed and redrawn also if its value has not changed. The "trick" to avoid (resp. minimize) the flickering is, draw any digit of the clock if and only if it changes its value. And draw the whole clock only at startup or if the position was changed by moving the "config" window and clicking the "Move" button. It is not 100% flicker-free but the flicker is visible only at the digit which is actually redrawn. Here comes the code: ---- ====== # Transparent Clock in pure Tcl: # original code by slebetman # # improvements for a flickerfree version # by HoMi # base position array set Config { X,base 10 Y,base 10 X,incr 160 Y,incr 0 } 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 40 10 b 045689 0 10 10 40 c 01234789 50 10 10 40 d 2345689 10 50 40 10 e 0268 0 60 10 40 f 013456789 50 60 10 40 g 0235689 10 100 40 10 } foreach {segment group x1 y1 width height} $segmentList { if {[string first $number $group] != -1} { # Experiment with -bg, -highlightbackground and # -highlightthickness to get the look you like: lappend ret [toplevel $rootname$segment \ -bg red -highlightbackground yellow \ -highlightthickness 1] # You should also experiment with other stuff # which affects toplevels like -relief and # wm attribute -alpha etc. # Unfortunately, only windows support -topmost # which I consider the "proper" behavior if {[lindex [winfo server .] 0] == "Windows"} { 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 } # improvement for drawing each digit separat # and only if it is required array set foo { hT {} h {} mT {} m {} sT {} s {} HT -1 H -1 MT -1 M -1 ST -1 S -1 } proc tick {} { global foo upvar #0 Config C set now [clock seconds] foreach {H M S} [split [clock format $now -format "%I.%M.%S"] .] break set sx $C(X,base) set sy $C(Y,base) foreach {HT H} [split $H {}] break if {$HT != $foo(HT)} { set foo(HT) $HT foreach x $foo(hT) {destroy $x} set foo(hT) [drawTransDigit .trans$sx $sx $sy $HT] } if {$H != $foo(H)} { set sx1 [expr {$sx + 70}] ;# distance between the two digits of the hours value set foo(H) $H foreach x $foo(h) {destroy $x} set foo(h) [drawTransDigit .trans$sx1 $sx1 $sy $H] } incr sx $C(X,incr) incr sy $C(Y,incr) foreach {MT M} [split $M {}] break if {$MT != $foo(MT)} { set foo(MT) $MT foreach x $foo(mT) {destroy $x} set foo(mT) [drawTransDigit .trans$sx $sx $sy $MT] } if {$M != $foo(M)} { set sx1 [expr {$sx + 70}] ;# distance between the two digits of the minutes value set foo(M) $M foreach x $foo(m) {destroy $x} set foo(m) [drawTransDigit .trans$sx1 $sx1 $sy $M] } incr sx $C(X,incr) incr sy $C(Y,incr) foreach {ST S} [split $S {}] break if {$ST != $foo(ST)} { set foo(ST) $ST foreach x $foo(sT) {destroy $x} set foo(sT) [drawTransDigit .trans$sx $sx $sy $ST] } if {$S != $foo(S)} { set sx1 [expr {$sx + 70}] ;# distance between the two digits of the seconds value set foo(S) $S foreach x $foo(s) {destroy $x} set foo(s) [drawTransDigit .trans$sx1 $sx1 $sy $S] } } proc every {ms body} {eval $body; after $ms [info level 0]} ;# thanks to [RS] every 1000 tick ;# redraw the 'changed' digits only one time per second # the 'configuration' window to move and/or exit the clock # show the coords pack [frame .fy] -side top pack [label .fy.l -text "Y,base :"] -side left pack [label .fy.v -textvariable Config(Y,base)] -side right pack [frame .fx] -side top pack [label .fx.l -text "X,base :"] -side left pack [label .fx.v -textvariable Config(X,base)] -side right # allow to movie the clock pack [button .move -command move -text "Move here"] -side left # allow to exit pack [button .exit -command exit -text "Exit"] -side right proc move {} { global Config foo array set foo {HT -1 H -1 MT -1 M -1 ST -1 S -1} set Config(X,base) [winfo x .] set Config(Y,base) [winfo y .] tick ;# redraw the whole clock at the new position } ====== As I stated in [FullyTransparentDigitalClock] a further step could be that only these segments of a digit will be destroyed which are not required to show the next value, and after this only the additional segments required for the next value will be created. This would result in a 100 percent flickerfree clock. But this requires a complete redesign of the application. And I have it done - see [FullyTransparentDigitalClock2] ---- !!!!!! %| [Category Application] | [Category Date and Time] |% !!!!!!