Subversion Repositories or1k

#!/bin/sh

# ----------------------------------------------------------------------

#  DEMO: scrolledcanvas in [incr Widgets]

# ----------------------------------------------------------------------

#\

exec itkwish "$0" ${1+"$@"}

package require Iwidgets 3.0

# itkwish interprets the rest...

# ----------------------------------------------------------------------

option add *textBackground seashell

. configure -background white

iwidgets::scrolledcanvas .canv -labeltext "Scrolledcanvas" \

    -vscrollmode dynamic -hscrollmode dynamic -autoresize yes

pack .canv -expand yes -fill both -padx 4 -pady 4

.canv xview moveto 0

.canv yview moveto 0

button .zoomin -text "Zoom In" -command {

    .canv scale all 0 0 2 2

    .canv configure -scrollregion [.canv bbox all]

}

pack .zoomin -side left -expand yes -padx 4 -pady 4

button .zoomout -text "Zoom Out" -command {

    .canv scale all 0 0 0.5 0.5

    .canv xview moveto 0

    .canv yview moveto 0

    .canv configure -scrollregion [.canv bbox all]

}

pack .zoomout -side left -expand yes -padx 4 -pady 4

bind [.canv component canvas]  {add_rectangle %W %x %y}

bind [.canv component canvas]  {add_rectangle %W %x %y}

proc add_rectangle {win x y} {

    set x [$win canvasx $x]

    set y [$win canvasy $y]

    $win create rectangle \

        [expr $x-4] [expr $y-4] \

        [expr $x+4] [expr $y+4] \

        -outline "" -fill red

    $win configure -scrollregion [$win bbox all]

}