Version 4 of Panner

Updated 2004-02-13 08:38:47

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. :)

Download: http://www.xmission.com/~georgeps/tcl_wiki/panner.tcl

Plans: http://www.xmission.com/~georgeps/tcl_wiki/panner.tcl.plan

 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 <KeyPress-Return> {puts [uplevel #0 $::eval_me]}

 bind .p <ButtonPress-1> {start.drag %X %Y}
 bind .p <B1-Motion> {drag .m .p %X %Y}
 }
 main

---

EB: Such widget exists in BWidget, named ScrollView [L1 ]. An example of use (http://eric.boudaillier.free.fr/graphe.png ) shows that the underlying canvas allow to draw other things.

---

Category Widget Category Graphics