Version 4 of Another MDI

Updated 2007-11-16 15:49:47 by LV

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

                               #######
  # 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 size_nw_se] -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