[Rohan Pall], made on Sept 24, 2003

More [MDI]!

Blatantly copied from [GPS]'s fantastic [Internal Movable Windows], with the addition of a resize corner.  Wow! ;P

[Stu] 2008-10-25 Changed cursor from "size_nw_se" (Windows only) to "sizing" (all platforms).

======tcl
                       #######
# The MDI uses the following globals:  qx,qy,nx,ny
                             #######

proc resize_start {w x y} {
  global qx qy
  set qx $x
  set qy $y
  #puts "start: $qx $qy"
}

proc resize_do {w x y} {
  global qx qy
  set dqx [expr {$x-$qx}]
  set dqy [expr {$y-$qy}]
  set cur_w [winfo width $w]
  set cur_h [winfo height $w]
  set new_w [expr {$cur_w+$dqx}]
  set new_h [expr {$cur_h+$dqy}]
  #puts "do: x:$x y:$y qx:$qx qy:$qy (dqx:$dqx dqy:$dqy)  $cur_w $cur_h => $new_w $new_h"
  # Only resize the window if its bigger than the allowed minimum size.
  if {$new_w >= 60} {place $w -width  $new_w}
  if {$new_h >= 50} {place $w -height $new_h}
}

proc move_start {w} {
  global nx ny
  set nx [winfo pointerx .]
  set ny [winfo pointery .]
  raise $w
}

proc move_do {w} {
  global nx ny
  set x [winfo pointerx .]
  set y [winfo pointery .]
  set dx [expr {$x-$nx}]
  set dy [expr {$y-$ny}]
  array set p [place info $w]
  set px [expr {$p(-x)+$dx}]
  set py [expr {$p(-y)+$dy}]
  place $w -x $px -y $py
  set nx $x
  set ny $y
}

proc make_win {w txt} {
  frame $w -bd 0
  pack [frame $w.titlebar -bg gold -relief raised -cursor fleur] -side bottom -fill x
  pack [label $w.titlebar.resize -text o -bg darkred -relief flat -bd 0 \
          -cursor sizing] -side right -anchor s
  pack [label $w.titlebar.title -font {{Lucida Console} 8} -bg gold -fg navy -text $w -anchor w] -side left
  pack [frame $w.c -padx 2 -pady 2 -bg gold] -side top -fill both -expand 1

  pack [text $w.c.t -width 20 -height 3] -fill both -expand 1
  $w.c.t insert end $txt

  bind $w.titlebar <1>          [list move_start $w]
  bind $w.titlebar <B1-Motion>  [list move_do $w]

  bind $w.titlebar <3> [list lower $w]

  bind $w.titlebar.title <1>          [list move_start $w]
  bind $w.titlebar.title <B1-Motion>  [list move_do $w]

  bind $w.titlebar.resize <1>         [list resize_start  $w %x %y]
  bind $w.titlebar.resize <B1-Motion> [list resize_do     $w %x %y]

  return $w
}

. conf -width 600 -height 400 -bg black
pack propagate . 0
place [make_win .w1 "Hello World"] -x 10 -y 40
place [make_win .w2 "Hello Person"] -x 300 -y 50

======

!!!!!!
%|[Category Widget]|%
!!!!!!