[ulis], 2002-09-10

If you need to move a transparent window to figure pasting something, here is a little package.

[http://perso.wanadoo.fr/maurice.ulis/tcl/ghost.png]

----
[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 namespace
======

----
'''The 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
======



<<categories>> Example | Package | GUI