#!/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 $argvNote: 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.
