# ------------------------------------------------------------------------------ # scrollview.tcl # This file is part of Unifix BWidget Toolkit # $Id: scrollview.tcl,v 1.4 2000/06/15 00:45:16 kuchler Exp $ # ------------------------------------------------------------------------------ # Index of commands: # - ScrolledWindow::create # - ScrolledWindow::configure # - ScrolledWindow::cget # - ScrolledWindow::_set_hscroll # - ScrolledWindow::_set_vscroll # - ScrolledWindow::_update_scroll # - ScrolledWindow::_set_view # - ScrolledWindow::_resize # ------------------------------------------------------------------------------ namespace eval ScrollView { Widget::tkinclude ScrollView canvas :canvas \ include {-relief -borderwidth -background -width -height -cursor} \ initialize {-relief flat -borderwidth 0 -width 30 -height 30 \ -cursor crosshair} Widget::declare ScrollView { {-width TkResource 30 0 canvas} {-height TkResource 30 0 canvas} {-background TkResource "" 0 canvas} {-foreground String black 0} {-fill String "" 0} {-relief TkResource flat 0 canvas} {-borderwidth TkResource 0 0 canvas} {-cursor TkResource crosshair 0 canvas} {-window String "" 0} {-fg Synonym -foreground} {-bg Synonym -background} {-bd Synonym -borderwidth} } # Widget::addmap ScrollView "" :canvas { # -relief {} -borderwidth {} -background {} # -width {} -height {} -cursor {} # } bind BwScrollView {ScrollView::_set_view %W set %x %y} bind BwScrollView {ScrollView::_set_view %W motion %x %y} bind BwScrollView {ScrollView::_resize %W} bind BwScrollView {ScrollView::_destroy %W} proc ::ScrollView {path args} { return [eval ScrollView::create $path $args] } proc use {} {} variable _widget } # ------------------------------------------------------------------------------ # Command ScrollView::create # ------------------------------------------------------------------------------ proc ScrollView::create { path args } { variable _widget Widget::init ScrollView $path $args eval canvas $path [Widget::subcget $path :canvas] -highlightthickness 0 rename $path ::$path:canvas set w [Widget::cget $path -window] set _widget($path,bd) [Widget::cget $path -borderwidth] set _widget($path,width) [Widget::cget $path -width] set _widget($path,height) [Widget::cget $path -height] if {[winfo exists $w]} { set _widget($path,oldxscroll) [$w cget -xscrollcommand] set _widget($path,oldyscroll) [$w cget -yscrollcommand] $w configure \ -xscrollcommand "ScrollView::_set_hscroll $path" \ -yscrollcommand "ScrollView::_set_vscroll $path" } $path:canvas create rectangle -2 -2 -2 -2 \ -fill [Widget::cget $path -fill] \ -outline [Widget::cget $path -foreground] \ -tags view bindtags $path [list $path BwScrollView [winfo toplevel $path] all] proc ::$path { cmd args } "return \[eval ScrollView::\$cmd $path \$args\]" return $path } # ------------------------------------------------------------------------------ # Command ScrollView::configure # ------------------------------------------------------------------------------ proc ScrollView::configure { path args } { variable _widget set oldw [Widget::getoption $path -window] set res [Widget::configure $path $args] if { [Widget::hasChanged $path -window w] } { if { [winfo exists $oldw] } { $oldw configure \ -xscrollcommand $_widget($path,oldxscroll) \ -yscrollcommand $_widget($path,oldyscroll) } if { [winfo exists $w] } { set _widget($path,oldxscroll) [$w cget -xscrollcommand] set _widget($path,oldyscroll) [$w cget -yscrollcommand] $w configure \ -xscrollcommand "ScrollView::_set_hscroll $path" \ -yscrollcommand "ScrollView::_set_vscroll $path" } else { $path:canvas coords view -2 -2 -2 -2 set _widget($path,oldxscroll) {} set _widget($path,oldyscroll) {} } } if { [Widget::hasChanged $path -fill fill] | [Widget::hasChanged $path -foreground fg] } { $path:canvas itemconfigure view \ -fill $fill \ -outline $fg } return $res } # ------------------------------------------------------------------------------ # Command ScrollView::cget # ------------------------------------------------------------------------------ proc ScrollView::cget { path option } { return [Widget::cget $path $option] } # ------------------------------------------------------------------------------ # Command ScrollView::_destroy # ------------------------------------------------------------------------------ proc ScrollView::_destroy { path } { variable _widget set w [Widget::getoption $path -window] if { [winfo exists $w] } { $w configure \ -xscrollcommand $_widget($path,oldxscroll) \ -yscrollcommand $_widget($path,oldyscroll) } unset _widget($path,oldxscroll) unset _widget($path,oldyscroll) unset _widget($path,bd) unset _widget($path,width) unset _widget($path,height) if {[info exists _widget($path,dx)]} { unset _widget($path,dx) } if {[info exists _widget($path,dy)]} { unset _widget($path,dy) } Widget::destroy $path rename $path {} } # ------------------------------------------------------------------------------ # Command ScrollView::_set_hscroll # ------------------------------------------------------------------------------ proc ScrollView::_set_hscroll { path vmin vmax } { variable _widget set c [$path:canvas coords view] set x0 [expr {$vmin*$_widget($path,width)+$_widget($path,bd)}] set x1 [expr {$vmax*$_widget($path,width)+$_widget($path,bd)-1}] $path:canvas coords view $x0 [lindex $c 1] $x1 [lindex $c 3] if { $_widget($path,oldxscroll) != "" } { uplevel \#0 $_widget($path,oldxscroll) $vmin $vmax } } # ------------------------------------------------------------------------------ # Command ScrollView::_set_vscroll # ------------------------------------------------------------------------------ proc ScrollView::_set_vscroll { path vmin vmax } { variable _widget set c [$path:canvas coords view] set y0 [expr {$vmin*$_widget($path,height)+$_widget($path,bd)}] set y1 [expr {$vmax*$_widget($path,height)+$_widget($path,bd)-1}] $path:canvas coords view [lindex $c 0] $y0 [lindex $c 2] $y1 if { $_widget($path,oldyscroll) != "" } { uplevel \#0 $_widget($path,oldyscroll) $vmin $vmax } } # ------------------------------------------------------------------------------ # Command ScrollView::_update_scroll # ------------------------------------------------------------------------------ proc ScrollView::_update_scroll { path callscroll hminmax vminmax } { variable _widget set c [$path:canvas coords view] set hmin [lindex $hminmax 0] set hmax [lindex $hminmax 1] set vmin [lindex $vminmax 0] set vmax [lindex $vminmax 1] set x0 [expr {$hmin*$_widget($path,width)+$_widget($path,bd)}] set x1 [expr {$hmax*$_widget($path,width)+$_widget($path,bd)-1}] set y0 [expr {$vmin*$_widget($path,height)+$_widget($path,bd)}] set y1 [expr {$vmax*$_widget($path,height)+$_widget($path,bd)-1}] $path:canvas coords view $x0 $y0 $x1 $y1 if { $callscroll } { if { $_widget($path,oldxscroll) != "" } { uplevel \#0 $_widget($path,oldxscroll) $hmin $hmax } if { $_widget($path,oldyscroll) != "" } { uplevel \#0 $_widget($path,oldyscroll) $vmin $vmax } } } # ------------------------------------------------------------------------------ # Command ScrollView::_set_view # ------------------------------------------------------------------------------ proc ScrollView::_set_view { path cmd x y } { variable _widget set w [Widget::getoption $path -window] if {[winfo exists $w]} { if {![string compare $cmd "set"]} { set c [$path:canvas coords view] set x0 [lindex $c 0] set y0 [lindex $c 1] set x1 [lindex $c 2] set y1 [lindex $c 3] if {$x >= $x0 && $x <= $x1 && $y >= $y0 && $y <= $y1} { set _widget($path,dx) [expr {$x-$x0}] set _widget($path,dy) [expr {$y-$y0}] return } else { set x0 [expr {$x-($x1-$x0)/2}] set y0 [expr {$y-($y1-$y0)/2}] set _widget($path,dx) [expr {$x-$x0}] set _widget($path,dy) [expr {$y-$y0}] set vh [expr {double($x0-$_widget($path,bd))/$_widget($path,width)}] set vv [expr {double($y0-$_widget($path,bd))/$_widget($path,height)}] } } elseif {![string compare $cmd "motion"]} { set vh [expr {double($x-$_widget($path,dx)-$_widget($path,bd))/$_widget($path,width)}] set vv [expr {double($y-$_widget($path,dy)-$_widget($path,bd))/$_widget($path,height)}] } $w xview moveto $vh $w yview moveto $vv _update_scroll $path 1 [$w xview] [$w yview] } } # ------------------------------------------------------------------------------ # Command ScrollView::_resize # ------------------------------------------------------------------------------ proc ScrollView::_resize { path } { variable _widget set _widget($path,bd) [Widget::getoption $path -borderwidth] set _widget($path,width) [expr {[winfo width $path]-2*$_widget($path,bd)}] set _widget($path,height) [expr {[winfo height $path]-2*$_widget($path,bd)}] set w [Widget::getoption $path -window] if { [winfo exists $w] } { _update_scroll $path 0 [$w xview] [$w yview] } }