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 $argvWhat categories should this be under?