Welcome, guest | Sign In | My Account | Store | Cart

Implementation of a scrollable pane in pure Tcl/Tk.

Tcl, 32 lines
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
proc scrollpane {w x y} {
   frame $w -class ScrollPane -width $x -height $y
   canvas $w.c -xscrollcommand [list $w.x set] -yscrollcommand [list $w.y set]
   scrollbar $w.x -orient horizontal -command [list $w.c xview]
   scrollbar $w.y -orient vertical   -command [list $w.c yview]
   set f [frame $w.c.content -borderwidth 0 -highlightthickness 0]
   $w.c create window 0 0 -anchor nw -window $f
   grid $w.c $w.y -sticky nsew
   grid $w.x      -sticky nsew
   grid rowconfigure    $w 0 -weight 1
   grid columnconfigure $w 0 -weight 1
   # This binding makes the scroll-region of the canvas behave correctly as
   # you place more things in the content frame.
   bind $f <Configure> [list scrollpane_cfg $w %w %h]
   $w.c configure -borderwidth 0 -highlightthickness 0
   return $f
}
proc scrollpane_cfg {w wide high} {
   set newSR [list 0 0 $wide $high]
   if {![string equals [$w cget -scrollregion] $newSR]} {
      $w configure -scrollregion $newSR
   }
}

### Demo code ###
set sp [scrollpane .s 95 235]
pack .s -fill both
pack [button .quit -text Quit -command exit] -fill both
for {set i 0} {$i<25} {incr i} {
   set text "This is button #$i of a sequence"
   pack [button $sp.b$i -text $text -command [list puts HI-$i]]
}

The above code creates rather a lot of windows, but since most applications tend not to use too many scrollable regions per window (for Human User Interface reasons; having lots just confuses many people) this isn't a big problem. Note that both the canvas and the content pane have their borderwidths and highlightthicknesses set to zero; this is because of the way windows get clipped by their parents which can make things look very strange. To see what I mean, try setting the borders to something wide (and using suitably garish colours) and watch as one laps on top of the other, looking very odd indeed...

3 comments

Paul Obermeier 22 years, 7 months ago  # | flag

Just what I was looking for, but. Note the following changes to make it work correctly:

proc scrollpane_cfg {w wide high} {
   set newSR [list 0 0 $wide $high]
   if {![string equal [$w.c cget -scrollregion] $newSR]} {
      $w.c configure -scrollregion $newSR
   }
}

Greetings, Paul

Mac Cody 22 years, 7 months ago  # | flag

Correction to code. Paul's code fix doesn't appear to work under MS Windows (I have not tried it on UNIX yet). The problem is in the testing of the results of the string compare. The following code is a correction:

proc scrollpane_cfg {w wide high} {
   set newSR [list 0 0 $wide $high]
   if {[string compare [$w.c cget -scrollregion] $newSR] != 0} {
      $w.c configure -scrollregion $newSR
   }
}
Daniel Lujan 21 years, 8 months ago  # | flag

scrollable pane : I need see my widget!! I need see my widget!!, ja ja (when tab key) ok, this code its util: (excuse my english, lujan99@usa.net)

proc scrollpane_see { path widget } {
#we need consider  frames 'containers':
for {set x0  0;set p $widget} {"$p"!="$path.c.content"} {set p [winfo parent $p]}  {
    incr x0 [winfo x $p]
    }
for {set y0  0;set p $widget} {"$p"!="$path.c.content"} {set p [winfo parent $p]}  {
    incr y0 [winfo y $p]
    }
set x1  [expr {$x0+[winfo width  $widget]}]
set y1  [expr {$y0+[winfo height $widget]}]
set xb0 [$path.c canvasx 0]
set yb0 [$path.c canvasy 0]
set xb1 [$path.c canvasx [winfo width  $path.c]]
set yb1 [$path.c canvasy [winfo height $path.c]]
set dx  0
set dy  0

if { $x1 > $xb1 } {    set dx [expr {$x1-$xb1}] }
if { $x0 I need see my widget!!, ja ja (when tab key)
ok, this code its util:
(excuse my english, lujan99@usa.net)


<pre>
proc scrollpane_see { path widget } {
#we need consider  frames 'containers':
for {set x0  0;set p $widget} {"$p"!="$path.c.content"} {set p [winfo parent $p]}  {
    incr x0 [winfo x $p]
    }
for {set y0  0;set p $widget} {"$p"!="$path.c.content"} {set p [winfo parent $p]}  {
    incr y0 [winfo y $p]
    }
set x1  [expr {$x0+[winfo width  $widget]}]
set y1  [expr {$y0+[winfo height $widget]}]
set xb0 [$path.c canvasx 0]
set yb0 [$path.c canvasy 0]
set xb1 [$path.c canvasx [winfo width  $path.c]]
set yb1 [$path.c canvasy [winfo height $path.c]]
set dx  0
set dy  0

if { $x1 > $xb1 } {    set dx [expr {$x1-$xb1}] }
if { $x0

</pre>

Created by Donal Fellows on Tue, 11 Sep 2001 (MIT)
Tcl recipes (162)
Donal Fellows's recipes (6)

Required Modules

  • (none specified)

Other Information and Tasks