Version 0 of scrolled.frame

Updated 2003-04-25 18:14:24

GPS @ April 25 2003 - For my SDynObject project I wrote a scrolled frame widget in order to demonstrate how easy it's to use SDynObject. The code below creates this image:

http://www.xmission.com/~georgeps/SDynObject/scrolled.frame.png

SDynObject is available under the terms of a license similar to Tcl. You can download it and this demo here: http://www.xmission.com/~georgeps/SDynObject


  source ./SDynObject.tcl

  proc scrolled.frame {win childWinPtr args} {
    upvar $childWinPtr childWin
    set obj [sd.new.object]

    if {[llength $args] & 1} {
      return -code error "bad number of arguments; uneven number: $args"
    }

    set options(-xscrollcommand) ""
    set options(-yscrollcommand) ""
    set options(-width) 200
    set options(-height) 200

    array set options $args

    foreach item [list -xscrollcommand -yscrollcommand -width -height] {
      $obj $item [set options($item)]
      unset options($item)
    }

    if {[array size options] > 0} {
      return -code error "invalid argument(s) to $win: [array get options]"
    }

    $obj didInitialConfigure 0

    sd.new.method update.xview.scrollbar for $obj takes {win args} {
      uplevel #0 [$self -xscrollcommand] $args
    }

    sd.new.method update.yview.scrollbar for $obj takes {win args} {
      uplevel #0 [$self -yscrollcommand]  $args
    }

    sd.new.method event.configure for $obj takes {win frameWin width height} {
      set halfWidth [expr {$width / 2}]
      set halfHeight [expr {$height / 2}]
      $win.c configure -scrollregion [list -$halfWidth -$halfHeight $halfWidth $halfHeight]

      if {0 == [$self didInitialConfigure]} {
        $win.c xview moveto 0
        $win.c yview moveto 0
        after idle [list $self didInitialConfigure 1]
      }
    }

    sd.new.method instance.handler for $obj takes {win args} {
      if {[llength $args] < 3} {
        return -code error "invalid number of arguments sent to $win"
      }

      set subCmd [lindex $args 0]
      if {"xview" == $subCmd} {
        uplevel #0 $win.c $args
      } elseif {"yview" == $subCmd} {
        uplevel #0 $win.c $args
      } else {
        return -code error "invalid subcommand sent to $win: $subCmd"
      }
    }

    frame $win

    canvas $win.c -xscrollcommand [list [$obj update.xview.scrollbar] $win] \
      -yscrollcommand [list [$obj update.yview.scrollbar] $win]

    pack $win.c -fill both -expand 1
    frame $win.c.f
    bind $win.c.f <Configure> [list [$obj event.configure] $win %W %w %h]
    $obj frameId [$win.c create window 0 0 -window $win.c.f]
    set childWin $win.c.f

    rename $win _orig$win
    interp alias {} $win {} [$obj instance.handler] $win

    return $win
  }

  #BEGIN DEMO
  proc add.more childWin {
    if {[winfo exists $childWin.l0]} {
      return
    }

    for {set i 0} {$i < 50} {incr i} {
      pack [label $childWin.l$i -text "Label $i"]
    }
  }

  proc main {} {
    pack [frame .fm] -fill both -expand 1

    scrollbar .fm.xscroll -orient horizontal -command [list .fm.sf xview]
    scrollbar .fm.yscroll -command [list .fm.sf yview]
    scrolled.frame .fm.sf childWin -xscrollcommand [list .fm.xscroll set] \
      -yscrollcommand [list .fm.yscroll set]

    grid .fm.xscroll -row 1 -column 0 -sticky we
    grid .fm.yscroll -row 0 -column 1 -sticky ns
    grid .fm.sf -row 0 -column 0 -sticky news

    grid rowconfigure .fm 0 -weight 1
    grid columnconfigure .fm 0 -weight 1

    for {set y 0} {$y < 40} {incr y} {
      pack [frame $childWin.f$y] -fill x
      for {set x 0} {$x < 20} {incr x} {
        pack [button $childWin.f$y.$x -text "$x $y"] -side left
      }
    }
    pack [button .b -text {Add More} -command [list add.more $childWin]]
  }
  main