Version 2 of Internal Movable Windows

Updated 2002-07-15 18:17:27

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?


  #!/bin/wish8.3

  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