Version 1 of Moving a ghost window

Updated 2002-09-15 08:40:10

ulis, 2002-09-10

If you need to move a transparent window to figure pasting something, here is a little 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    50
    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

  # ====================
  #
  #   demo
  #
  # ====================

  foreach {key value} \
  {
    iprefix     .f.
    xprefix     .top
    color       gray50
    width       180
    height      30
    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 . 300x300