# ScrolledCanvas.tcl is a scrollable canvas using standard techniques
# as described for example in Brent B. Welch's book "Practical
# Programming in Tcl and Tk"
proc ScrolledCanvas {c args} {
frame $c
eval {canvas $c.canvas \
-xscrollcommand [list $c.xscroll set] \
-yscrollcommand [list $c.yscroll set] \
-highlightthickness 0 \
-borderwidth 0} $args
scrollbar $c.xscroll -orient horizontal \
-command [list $c.canvas xview]
scrollbar $c.yscroll -orient vertical \
-command [list $c.canvas yview]
grid $c.canvas $c.yscroll -sticky news
grid $c.xscroll -sticky ew
grid rowconfigure $c 0 -weight 1
grid columnconfigure $c 0 -weight 1
return $c.canvas
}and
# Drawer.tcl will drop a few objects (arrows etc.) onto a canvas
proc DrawLeftMark {canvas color {width ""} {height ""}} {
if {$height == ""} {
set h [$canvas cget -height]
} else {
set h $height
}
set x1 0
set x2 [expr {$h - 1}]
set x3 [expr {($h * 4) - 1}]
set y1 0
set y5 [expr {$h - 1}]
set y3 [expr {($y1 + $y5) / 2}]
set y2 [expr {$y3 - ($h / 4)}]
set y4 [expr {$y3 + ($h / 4)}]
$canvas create polygon \
$x1 $y3 $x2 $y1 $x2 $y2 $x3 $y2 $x3 $y4 $x2 $y4 $x2 $y5 $x1 $y3 \
-fill $color \
-outline black
}
proc DrawRightMark {canvas color {width ""} {height ""}} {
if {$width == ""} {
set w [$canvas cget -width]
} else {
set w $width
}
if {$height == ""} {
set h [$canvas cget -height]
} else {
set h $height
}
set x1 [expr {$w - 1}]
set x2 [expr {$w - $h - 1}]
set x3 [expr {$w - ($h * 4) - 1}]
set y1 0
set y5 [expr {$h - 1}]
set y3 [expr {($y1 + $y5) / 2}]
set y2 [expr {$y3 - ($h / 4)}]
set y4 [expr {$y3 + ($h / 4)}]
$canvas create polygon \
$x1 $y3 $x2 $y1 $x2 $y2 $x3 $y2 $x3 $y4 $x2 $y4 $x2 $y5 \
-fill $color \
-outline black
}
proc DrawTicks {canvas {width ""}} {
if {$width == ""} {
set w [$canvas cget -width]
} else {
set w $width
}
set lm 0
set rm $w
set tickSpace [expr {$w / 1000}]
if {$tickSpace < 200} {set tickSpace 200}
for {set x $lm} {$x <= $rm} {incr x $tickSpace} {
$canvas create text $x 0 -text $x -anchor nw
}
}Now for the first example: draw a simple canvas with 800 million pixels and drop a few objects on that. This example will work flawlessly:
source ScrolledCanvas.tcl
source Drawer.tcl
# The following code for a simple canvas works fine for "small"
# scroll regions and for "large" scroll regions
#set scrollWidth 20000
set scrollWidth 800000000
set scrollHeight 400
set rowHeight 20
# Create a ScrolledCanvas and setup its scroll region
set sc [ScrolledCanvas .c -width 400 -height 200]
$sc configure -scrollregion "0 0 $scrollWidth $scrollHeight"
# Make the ScrollableWindow visible
pack .c -fill both -expand true
DrawLeftMark $sc yellow $scrollWidth $rowHeight
DrawRightMark $sc yellow $scrollWidth $rowHeight
DrawTicks $sc $scrollWidth
# Show the canvas coordinates of the mouse pointer for
# validation
set location [label .location -textvariable cur_x_y]
pack .location
bind Canvas <Motion> {ShowLocation %W %x %y}
bind Canvas <Leave> {set cur_x_y ""}
proc ShowLocation {w x y} {
global cur_x_y
set cx [expr int([$w canvasx $x])]
set cy [expr int([$w canvasy $y])]
set cur_x_y "x = $cx , y = $cy"
}So, if that works, packing some canvases together in one frame to scroll them should work too, right? Nope, sorry, it wont:
# Demo program for the creation of a scrollable multi row canvas
# using native Tcl/Tk methods
source ScrolledCanvas.tcl
source Drawer.tcl
# The following code works fine for "small" scroll regions,
# but runs into problems with "large" scroll regions. Try,
# for example, a scroll width of 40,000 pixel (let alone
# 800,000,000 pixel).
# Windows will exit abnormally, running under Linux (albeit
# with a display on Solaris) gives different effects for
# different lengths ... objects not shown, canvas too small etc.)
set scrollWidth 40000
#set scrollWidth 800000000
set scrollHeight 400
set rowHeight 20
# Create a ScrolledCanvas and setup its scroll region
set sc [ScrolledCanvas .c -width 400 -height 200]
$sc configure -scrollregion "0 0 $scrollWidth $scrollHeight"
# Create a frame widget within the ScrolledCanvas, which
# will serve as a container for the individual rows
set sf [frame $sc.f]
$sc create window 0 0 -anchor nw -window $sf
# Make the ScrolledCanvas visible.
pack .c -fill both -expand true
# Create some rows (canvas widgets) for displaying data...
set row1 [canvas $sf.c1 \
-width $scrollWidth \
-height $rowHeight \
-highlightthickness 0 \
-bg lightyellow]
DrawLeftMark $row1 yellow $scrollWidth $rowHeight
DrawRightMark $row1 yellow $scrollWidth $rowHeight
DrawTicks $row1 $scrollWidth
set row2 [canvas $sf.c2 \
-width $scrollWidth \
-height $rowHeight \
-highlightthickness 0 \
-bg orange]
DrawLeftMark $row2 brown
DrawRightMark $row2 brown
DrawTicks $row2
set row3 [canvas $sf.c3 \
-width $scrollWidth \
-height $rowHeight \
-highlightthickness 0 \
-bg lightgreen]
DrawLeftMark $row3 green
DrawRightMark $row3 green
DrawTicks $row3
set row4 [canvas $sf.c4 \
-width $scrollWidth \
-height $rowHeight \
-highlightthickness 0 \
-bg pink]
DrawLeftMark $row4 red
DrawRightMark $row4 red
DrawTicks $row4
# ... and put them into the ScrolledCanvas.
grid $row1 -row 0
grid $row2 -row 1
grid $row3 -row 2
grid $row4 -row 3
# swap row2 and row3:
#grid $row2 -row 2
#grid $row3 -row 1
# hide row2:
#grid forget $row2
# Show the canvas coordinates of the mouse pointer for
# validation
set location [label .location -textvariable cur_x_y]
pack .location
bind Canvas <Motion> {ShowLocation %W %x %y}
bind Canvas <Leave> {set cur_x_y ""}
proc ShowLocation {w x y} {
global cur_x_y
set cx [expr int([$w canvasx $x])]
set cy [expr int([$w canvasy $y])]
set cur_x_y "x = $cx , y = $cy"
}The question is now: why?
Category Widget
