Bryan Oakley 2003-09-29 On my mac with X11 the ghost window sometimes appears behind the toplevel.
The package
# #################################
#
# a ghost window
# move a rectangular transparent window
# inside a window or over the screen
#
# ulis, 2002
#
# NOL (No Obligation Licence)
#
# #################################
# usage (see demo at the bottom)
# external:
# bind . <ButtonPress-1> { ::ghost::xstart %X %Y }
# bind . <ButtonRelease-1> { ::ghost::xstop }
# bind . <Motion> { ::ghost::xmove %X %Y }
# internal:
# bind . <ButtonPress-1> { ::ghost::istart %X %Y }
# bind . <ButtonRelease-1> { ::ghost::istop }
# bind . <Motion> { ::ghost::imove %X %Y }
# #################################
# parameters (see demo at the bottom)
# color color of the ghost window
# width width of the ghost window
# height height of the ghost window
# thickness thickness of the ghost window
# iprefix ghost window prefix inside a window
# xprefix ghost window prefix over the screen
# #################################
# ----------------------
# package
# ----------------------
if {![catch { package present ghost }]} { return }
package provide ghost 0
package require Tk
# ----------------------
# create ::ghost namespace
# ----------------------
namespace eval ::ghost \
{
namespace export istart xstart
namespace export istop xstop
namespace export imove xmove move
# ---------------------
# ghost parameters
# ---------------------
array set {} \
{
color black
width 200
height 100
thickness 1
iprefix .f.
xprefix .top
}
# ---------------------
# create ghost
# ---------------------
proc icreate {} \
{
variable {}
foreach {side ww hh} \
[list \
t $(width) $(thickness) \
b $(width) $(thickness) \
l $(thickness) $(height) \
r $(thickness) $(height) ] \
{
canvas $(iprefix)$side -bg $(color) -bd 0 \
-width $ww -height $hh \
-highlightthickness 0 -selectborder 0
}
}
proc xcreate {} \
{
variable {}
foreach {side ww hh} \
[list \
t $(width) $(thickness) \
b $(width) $(thickness) \
l $(thickness) $(height) \
r $(thickness) $(height) ] \
{
set top $(xprefix)$side
toplevel $top
canvas $top.c -bg $(color) -bd 0 \
-width $ww -height $hh \
-highlightthickness 0 -selectborder 0
pack $top.c
wm withdraw $top
wm overrideredirect $top 1
}
}
# ---------------------
# starting ghost
# ---------------------
proc istart {x y} \
{
variable {}
if {![winfo exists $(iprefix)t]} { icreate }
set parent [winfo parent $(iprefix)t]
set (X) $x; set (Y) $y
set dx 0; set dy 0
set w2 [expr {$(width) / 2}]
set (x0) [expr {$x - $w2 - [winfo rootx $parent]}]
set h2 [expr {$(height) / 2}]
set (y0) [expr {$y - $h2 - [winfo rooty $parent]}]
ighost $(x0) $(y0)
set (cmd) ighost
}
proc xstart {x y} \
{
variable {}
if {![winfo exists $(xprefix)t]} { xcreate }
set (X) $x; set (Y) $y
set dx 0; set dy 0
set w2 [expr {$(width) / 2}]
set (x0) [expr {$x - $w2}]
set h2 [expr {$(height) / 2}]
set (y0) [expr {$y - $h2}]
xghost $(x0) $(y0)
foreach side { t b l r } { wm deiconify $(xprefix)$side }
set (cmd) xghost
}
# ---------------------
# stopping ghost
# ---------------------
proc istop {} \
{
variable {}
unset (X) (Y)
foreach side { t b l r } { place forget $(iprefix)$side }
}
proc xstop {} \
{
variable {}
unset (X) (Y)
foreach side { t b l r } { wm withdraw $(xprefix)$side }
}
# ---------------------
# moving ghost
# ---------------------
interp alias {} ::ghost::imove {} ::ghost::move
interp alias {} ::ghost::xmove {} ::ghost::move
proc move {x y} \
{
variable {}
if {[info exists (X)]} \
{
set dx [expr {$(X) - $x}]; set dy [expr {$(Y) - $y}]
$(cmd) [expr {$(x0) - $dx}] [expr {$(y0) - $dy}]
}
}
# ---------------------
# drawing ghost
# ---------------------
proc ighost {x y} \
{
variable {}
set parent [winfo parent $(iprefix)t]
place $(iprefix)t -in $parent -x $x -y $y
place $(iprefix)l -in $parent -x $x -y $y
incr y $(height); incr y -$(thickness)
place $(iprefix)b -in $parent -x $x -y $y
incr y -$(height); incr y $(thickness)
incr x $(width); incr x -$(thickness)
place $(iprefix)r -in $parent -x $x -y $y
}
proc xghost {x y} \
{
variable {}
wm geometry $(xprefix)t +$x+$y
wm geometry $(xprefix)l +$x+$y
incr y $(height); incr y -$(thickness)
wm geometry $(xprefix)b +$x+$y
incr y -$(height); incr y $(thickness)
incr x $(width); incr x -$(thickness)
wm geometry $(xprefix)r +$x+$y
}
}
# end of the ::ghost namespaceThe demo
# ====================
#
# demo
#
# ====================
foreach {key value} \
{
iprefix .f.
xprefix .top
color gray50
width 180
height 60
thickness 2
} \
{ set ::ghost::($key) $value }
bind . <ButtonPress-1> { ::ghost::xstart %X %Y }
bind . <ButtonRelease-1> { ::ghost::xstop }
bind . <ButtonPress-3> { ::ghost::istart %X %Y }
bind . <ButtonRelease-3> { ::ghost::istop }
bind . <Motion> { ::ghost::move %X %Y }
pack [frame .f] -expand 1 -fill both
pack [label .f.l1 -text "drag mouse button 1 from me" -height 5]
pack [label .f.l3 -text "drag mouse button 3 inside me" -height 5]
wm geometry . 300x200