30 lines
759 B
Tcl
30 lines
759 B
Tcl
|
# canvas.tcl - Handy canvas-related commands.
|
||
|
|
# Copyright (C) 1997 Cygnus Solutions.
|
||
|
|
# Written by Tom Tromey <tromey@cygnus.com>.
|
||
|
|
|
||
|
|
# Set scroll region on canvas.
|
||
|
|
proc set_scroll_region {canvas} {
|
||
|
|
set bbox [$canvas bbox all]
|
||
|
|
if {[llength $bbox]} then {
|
||
|
|
set sr [lreplace $bbox 0 1 0 0]
|
||
|
|
} else {
|
||
|
|
set sr {0 0 0 0}
|
||
|
|
}
|
||
|
|
|
||
|
|
# Don't include borders in the scrollregion.
|
||
|
|
set delta [expr {2 * ([$canvas cget -borderwidth]
|
||
|
|
+ [$canvas cget -highlightthickness])}]
|
||
|
|
|
||
|
|
set ww [winfo width $canvas]
|
||
|
|
if {[lindex $sr 2] < $ww} then {
|
||
|
|
set sr [lreplace $sr 2 2 [expr {$ww - $delta}]]
|
||
|
|
}
|
||
|
|
|
||
|
|
set wh [winfo height $canvas]
|
||
|
|
if {[lindex $sr 3] < $wh} then {
|
||
|
|
set sr [lreplace $sr 3 3 [expr {$wh - $delta}]]
|
||
|
|
}
|
||
|
|
|
||
|
|
$canvas configure -scrollregion $sr
|
||
|
|
}
|