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).
####### # 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