Page 2
Page 3
Code
if {[string equal "windows" $::tcl_platform(platform)]} {console show}
proc snap2screen {W} {
# so unmaximizing a toplevel on windows works
if {[string equal "zoomed" [wm state $W]]} return
# always returns the same on windows once prog is started - bug in Tk!
set sw [winfo screenwidth $W]
set sh [winfo screenheight $W]
foreach {w h x y} [string map {x " " + " "} [winfo geometry $W]] break
set sensi 40 ;# the magnetic border sensitivity
set snapped 0 ;# do we need to snap the window anywhere?
# Trick: Only do one of the snapping for each axis, we dont want a big
# window to be pulled from one side to the other... thats dumb ;)
set yt 0
set syt $y
set yb [expr {$sh - 54}] ;# add some space coz of the taskbar on windows
set syb [expr {$h + $y}]
if {$syt <= ($yt + $sensi)} {
puts "snapping to yt"
set snapped 1 ; set y $yt
} elseif {$syb >= ($yb - $sensi)} {
puts "snapping to yb"
set snapped 1 ; set y [expr {$yb - $h}]
}
set xr [expr {$sw - 8}] ;# add some pixel padding to look nice on windows
set sxr [expr {$w + $x}]
set xl 0
set sxl $x
if {$sxr >= ($xr - $sensi)} {
puts "snapping to xr"
set snapped 1 ; set x [expr {$xr - $w}]
} elseif {$sxl <= ($xl + $sensi)} {
puts "snapping to xl"
set snapped 1 ; set x $xl
}
if {$snapped} {
# drop the configure binding for a sec so we dont get into recursive hell!
set cscript [bind $W <Configure>]
bind $W <Configure> {}
wm geometry $W [join [list $w x $h + $x + $y] ""] ;# do the snap
update ;# so that the window gets moved now, without this there is trouble
bind $W <Configure> $cscript
} else {
puts "not snapped"
}
}
bind . <Configure> {snap2screen %W}
toplevel .top
bind .top <Configure> {snap2screen %W}GPS: I like it. The only issue is the window bouncing back and forth in XP when I move to the edges. I may look into that problem tomorrow. Thanks for sharing.
Ro: Great! I've got to get WinXP and 2000 to test these things on. Thanks for your offer, I appreciate your help ;)
