Internal Movable Windows

Thu Jan 31 13:09:19 MST 2002 - GPS: For a project I'm working on I needed to have movable windows. I played around with normal toplevel windows, and transient toplevel windows, but I couldn't get them to please me. I decided that an internal window (frame) would be just as good, so I came up with this code to move internal windows that act like toplevels.

KBK asks, is this the controversial MDI putting in an appearance again?

Ro replies: MDI can be useful. Depends on whatcha doin'.


  proc window:internal:move:start {win} {
        upvar _window$win offset

        set offset(x) [winfo pointerx .]
        set offset(y) [winfo pointery .]
        raise $win

  proc window:internal:move {win} {        
        upvar _window$win offset

        set wmX [winfo pointerx .]
        set wmY [winfo pointery .]

        set xDiff [expr {$wmX - $offset(x)}]
        set yDiff [expr {$wmY - $offset(y)}]

        array set placeInfo [place info $win]

        set placeX [expr {$placeInfo(-x) + $xDiff}]
        set placeY [expr {$placeInfo(-y) + $yDiff}]
        place $win -x $placeX -y $placeY

        set offset(x) $wmX
        set offset(y) $wmY
  proc makeWindow {win txt} {
        frame $win -bd 1 -relief raised
        pack [frame $win.titlebar -bd 1 -relief raised -cursor fleur] -side top -fill x
        pack [label $win.titlebar.title -text "Movable Window"] -side left
        pack [button $win.titlebar.done -text Done -padx 1 -pady 0 -bd 1 \
                -cursor center_ptr -command "destroy $win"] -side right
        pack [text $win.t -width 20 -height 3] -side top -fill both -expand 1
        $win.t insert end $txt
        bind $win.titlebar <ButtonPress-1> "window:internal:move:start $win"
        bind $win.titlebar <B1-Motion> "window:internal:move $win"
        bind $win.titlebar.title <ButtonPress-1> "window:internal:move:start $win"
        bind $win.titlebar.title <B1-Motion> "window:internal:move $win"
        return $win

  proc main {argc argv} {

        pack propagate . 0
        pack [label .l -text Desktop] -side top
        . config -width 600 -height 600

        place [makeWindow .win1 "Hello World"] -x 10 -y 40
        place [makeWindow .win2 "Hello Person"] -x 300 -y 50
  main $argc $argv

This is Really Cool! Ro

Fun, now you just need to add docking to it KPV

..and resizing, iconisation.. But two little changes I made in my copy - change the "Done" text to "x"; make the title bar -bg darkblue -fg white ... Even if MDI is not the best way, Tcl is great for such experiments, and I will do some more (e.g. graphic programming: plug function units together, generate Tcl code from their structure) RS

Larry Smith See also WeeDesk.

Do you know why I adore this code? Because it is tiny. [L1 ] Thanks a MILLION GPS! --ro - RS: from me too - KISS