[GPS]: Feb 12, 2004 - In reponse to a question asked on this Wiki about panning widgets I wrote a demonstration. This could fairly easily be turned into a reusable megawidget by someone with some time. :) ---- proc update.panner.view {win panner type args} { foreach {x1 y1 x2 y2} [$panner coords panner] {} if {"x" == $type} { set x1 [expr {[winfo width $panner] * [lindex $args 0]}] set x2 [expr {[winfo width $panner] * [lindex $args 1]}] } else { set y1 [expr {[winfo height $panner] * [lindex $args 0]}] set y2 [expr {[winfo height $panner] * [lindex $args 1]}] } $panner coords panner [list $x1 $y1 $x2 $y2] } proc start.drag {x y} { variable start_x variable start_y set start_x $x set start_y $y } proc drag {win panner x y} { variable start_x variable start_y set x_diff [expr {$x - $start_x}] set y_diff [expr {$y - $start_y}] foreach {sx1 sy1 sx2 sy2} [$win cget -scrollregion] {} foreach {xv1 xv2} [$win xview] {} set xview_limit [expr {1.0 - ($xv2 - $xv1)}] foreach {yv1 yv2} [$win yview] {} set yview_limit [expr {1.0 - ($yv2 - $yv1)}] set pxview [expr {((1.0 / [winfo width $panner]) * $x_diff) + $xv1}] if {$pxview < 0.0} { $win xview moveto 0.0 } elseif {$pxview > $xview_limit} { $win xview moveto $xview_limit } else { $win xview moveto $pxview set start_x $x } set pyview [expr {((1.0 / [winfo height $panner]) * $y_diff) + $yv1}] if {$pyview < 0.0} { $win yview moveto 0.0 } elseif {$pyview > $yview_limit} { $win yview moveto $yview_limit } else { $win yview moveto $pyview set start_y $y } } proc main {} { canvas .m -width 400 -height 400 -bg blue canvas .p -width 100 -height 100 -bg orange grid .p -row 0 -column 0 grid .m -row 0 -rowspan 2 -column 1 -sticky news grid rowconfigure . 1 -weight 100 grid columnconfigure . 1 -weight 100 .p create rectangle 0 0 100 100 -tags panner -fill purple .m create rectangle -300 20 -200 50 -fill green .m create rectangle -50 500 50 600 -fill red text .m.t -width 60 -height 20 .m create window 200 200 -window .m.t .m.t insert end "Hello, I'm a text widget embedded in a canvas with a\ panner.\n\nThe orange window represents the total area of the canvas.\ The purple area represents the current view area. You may\ shrink/enlarge the window and the panner will compensate. You may use/copy/modify the code under the same terms as Tcl. By George Peter Staplin." .m config -xscrollcommand {update.panner.view .m .p x} .m config -yscrollcommand {update.panner.view .m .p y} .m config -scrollregion {-500 0 500 1000} entry .e -textvariable ::eval_me grid .e bind .e {puts [uplevel #0 $::eval_me]} bind .p {start.drag %X %Y} bind .p {drag .m .p %X %Y} } main ---- [EB]: Such widget exists in [BWidget], named ''ScrollView'' [http://tcllib.sourceforge.net/BWman/ScrollView.html]. ---- [Category Widget] [Category Graphics]