46 lines
1.3 KiB
Text
46 lines
1.3 KiB
Text
|
# ----------------------------------------------------------------------
|
||
|
|
# DEMO: scrolledcanvas in [incr Widgets]
|
||
|
|
# ----------------------------------------------------------------------
|
||
|
|
package require Iwidgets 4.0
|
||
|
|
|
||
|
|
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] <ButtonPress-1> {add_rectangle %W %x %y}
|
||
|
|
bind [.canv component canvas] <B1-Motion> {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]
|
||
|
|
}
|