canvas.tcl

来自「windows下的GDB insight前端」· TCL 代码 · 共 30 行

# canvas.tcl - Handy canvas-related commands.
# Copyright (C) 1997 Cygnus Solutions.
# Written by Tom Tromey <[e-mail]>.

# 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
}