widget:resizeHandle

GPS Sun May 12, 2002: A resize handle is that funky thing usually on the bottom right of a window that you can use to resize a window. My version is slightly different, because it works with internal/MDI windows, and toplevel root parented windows. The interface commands are widget:resizeHandle and widget:resizeHandle:internal


  #!/bin/wish8.3
  
  image create bitmap widget:resizeHandle:image -data {
  #define resizeHandle_width 25
  #define resizeHandle_height 25
  static unsigned char resizeHandle_bits[] = {
     0x40, 0x10, 0x04, 0x01, 0x20, 0x08, 0x82, 0x00, 0x10, 0x04, 0x41, 0x00,
     0x08, 0x82, 0x20, 0x00, 0x04, 0x41, 0x10, 0x00, 0x82, 0x20, 0x08, 0x00,
     0x41, 0x10, 0x04, 0x01, 0x20, 0x08, 0x82, 0x00, 0x10, 0x04, 0x41, 0x00,
     0x08, 0x82, 0x20, 0x00, 0x04, 0x41, 0x10, 0x00, 0x82, 0x20, 0x08, 0x00,
     0x41, 0x10, 0x04, 0x01, 0x20, 0x08, 0x82, 0x00, 0x10, 0x04, 0x41, 0x00,
     0x08, 0x82, 0x20, 0x00, 0x04, 0x41, 0x10, 0x00, 0x82, 0x20, 0x08, 0x00,
     0x41, 0x10, 0x04, 0x01, 0x20, 0x08, 0x82, 0x00, 0x10, 0x04, 0x41, 0x00,
     0x08, 0x82, 0x20, 0x00, 0x04, 0x41, 0x10, 0x00, 0x82, 0x20, 0x08, 0x00,
     0x41, 0x10, 0x04, 0x00};
  }
  
  proc widget:resizeHandle:event:ButtonPress-1 {win resizeWin X Y} {
    upvar #0 _resizeHandle$win ar
    set ar(startX) $X
    set ar(startY) $Y
    set ar(minWidth) [image width widget:resizeHandle:image]
    set ar(minHeight) [image height widget:resizeHandle:image]
    set ar(resizeWinX) [winfo x $resizeWin]
    set ar(resizeWinY) [winfo y $resizeWin]
  }
  
  proc widget:resizeHandle:event:B1-Motion {win resizeWin internal X Y} {
    upvar #0 _resizeHandle$win ar
  
    set xDiff [expr {$X - $ar(startX)}]
    set yDiff [expr {$Y - $ar(startY)}]
    
    set oldWidth [winfo width $resizeWin]
    set oldHeight [winfo height $resizeWin]
    
    set newWidth [expr {$oldWidth + $xDiff}]
    set newHeight [expr {$oldHeight + $yDiff}]
    
    if {$newWidth < $ar(minWidth) || $newHeight < $ar(minHeight)} {
      return
    }
    
    if {$internal == 0} {
      if {$ar(resizeWinX) >= 0} {
        set newX "+$ar(resizeWinX)"
      }
      if {$ar(resizeWinY) >= 0} {
        set newY "+$ar(resizeWinY)"
      }
  
      wm geometry $resizeWin ${newWidth}x${newHeight}${newX}${newY}
    } else {
      place $resizeWin -width $newWidth -height $newHeight -x $ar(resizeWinX) -y $ar(resizeWinY)
    }
  
    set ar(startX) $X
    set ar(startY) $Y
  }
  
  proc widget:resizeHandle:event:Destroy {win} {
    upvar #0 _resizeHandle$win ar
    #catch because this may not be set
    catch {array unset ar}
  }
  
  proc widget:resizeHandle {win resizeWin args} {
    eval label [concat $win $args -image widget:resizeHandle:image]
    
    bind $win <ButtonPress-1> "widget:resizeHandle:event:ButtonPress-1 $win $resizeWin %X %Y"
    bind $win <B1-Motion> "widget:resizeHandle:event:B1-Motion $win $resizeWin 0 %X %Y"
    bind $win <Destroy> "widget:resizeHandle:event:Destroy $win"
    return $win
  }
  
  proc widget:resizeHandle:internal {win resizeWin args} {
    eval label [concat $win $args -image widget:resizeHandle:image]
  
    bind $win <ButtonPress-1> "widget:resizeHandle:event:ButtonPress-1 $win $resizeWin %X %Y"
    bind $win <B1-Motion> "widget:resizeHandle:event:B1-Motion $win $resizeWin 1 %X %Y"
    bind $win <Destroy> "widget:resizeHandle:event:Destroy $win"
    return $win
  }
  
  #Test code
  proc main {argc argv} {
    option add *Frame.background #909090
    option add *background #b0b0b0
    option add *foreground black
    option add *activeBackground #b0a090
  
    wm title . "Internal resizeHandle Demo"
    
    pack [button .exit -text "Press to Exit" -command exit] -side top
    pack [button .b -text Destroy -command {destroy .resizeFrame}] -side top
    #widget:resizeHandle doesn't work with a window managed with -relx or -rely.
    #It also only works with the place manager at the moment.
    place [frame .resizeFrame -bg royalblue -bd 2 -relief raised -width 250 -height 250] -x 40 -y 60
    pack [message .resizeFrame.msg -text "This would normally be a window with a titlebar for movement.\
   If you have a need for such a thing look at the internal movable windows page on the Tcl'ers Wiki."] -side top
    
    pack [widget:resizeHandle:internal .resizeFrame.resizeHandle .resizeFrame] -side bottom -anchor e

    toplevel .t
    wm transient .t .
    wm title .t "Toplevel resizeHandle Demo"
    
    pack [button .t.exit -text "Press to Exit" -command exit] -anchor c
    pack [frame .t.bottomFrame] -side bottom -anchor e
    pack [widget:resizeHandle .t.bottomFrame.resizeHandle .t] -side left
  }
  main $argc $argv

Note: the internal demo above has an issue with the initial size of the window. You will need to make the main window bigger before you can see the internal resizable window.