1# ---------------------------------------------------------------------------- 2# scrollframe.tcl 3# This file is part of Unifix BWidget Toolkit 4# $Id: scrollframe.tcl,v 1.4 2003/02/25 09:47:50 hobbs Exp $ 5# ---------------------------------------------------------------------------- 6# Index of commands: 7# - ScrollableFrame::create 8# - ScrollableFrame::configure 9# - ScrollableFrame::cget 10# - ScrollableFrame::getframe 11# - ScrollableFrame::see 12# - ScrollableFrame::xview 13# - ScrollableFrame::yview 14# - ScrollableFrame::_resize 15# ---------------------------------------------------------------------------- 16 17namespace eval ScrollableFrame { 18 Widget::declare ScrollableFrame { 19 {-background TkResource "" 0 frame} 20 {-width Int 0 0 {}} 21 {-height Int 0 0 {}} 22 {-areawidth Int 0 0 {}} 23 {-areaheight Int 0 0 {}} 24 {-constrainedwidth Boolean 0 0} 25 {-constrainedheight Boolean 0 0} 26 {-xscrollcommand TkResource "" 0 canvas} 27 {-yscrollcommand TkResource "" 0 canvas} 28 {-xscrollincrement TkResource "" 0 canvas} 29 {-yscrollincrement TkResource "" 0 canvas} 30 {-bg Synonym -background} 31 } 32 33 Widget::addmap ScrollableFrame "" :cmd { 34 -background {} -width {} -height {} 35 -xscrollcommand {} -yscrollcommand {} 36 -xscrollincrement {} -yscrollincrement {} 37 } 38 Widget::addmap ScrollableFrame "" .frame {-background {}} 39 40 variable _widget 41 42 bind BwScrollableFrame <Configure> {ScrollableFrame::_resize %W} 43 bind BwScrollableFrame <Destroy> {Widget::destroy %W; rename %W {}} 44 45 proc ::ScrollableFrame { path args } { return [eval ScrollableFrame::create $path $args] } 46 proc use {} {} 47} 48 49 50# ---------------------------------------------------------------------------- 51# Command ScrollableFrame::create 52# ---------------------------------------------------------------------------- 53proc ScrollableFrame::create { path args } { 54 Widget::init ScrollableFrame $path $args 55 56 set canvas [eval canvas $path [Widget::subcget $path :cmd] \ 57 -highlightthickness 0 -borderwidth 0 -relief flat] 58 59 set frame [eval frame $path.frame [Widget::subcget $path .frame] \ 60 -highlightthickness 0 -borderwidth 0 -relief flat] 61 62 $canvas create window 0 0 -anchor nw -window $frame -tags win \ 63 -width [Widget::cget $path -areawidth] \ 64 -height [Widget::cget $path -areaheight] 65 66 bind $frame <Configure> \ 67 [list ScrollableFrame::_frameConfigure $canvas $frame %w %h] 68 bindtags $path [list $path BwScrollableFrame [winfo toplevel $path] all] 69 70 rename $path ::$path:cmd 71 proc ::$path { cmd args } \ 72 "return \[eval ScrollableFrame::\$cmd [list $path] \$args\]" 73 74 return $canvas 75} 76 77 78# ---------------------------------------------------------------------------- 79# Command ScrollableFrame::configure 80# ---------------------------------------------------------------------------- 81proc ScrollableFrame::configure { path args } { 82 set res [Widget::configure $path $args] 83 set upd 0 84 85 set modcw [Widget::hasChanged $path -constrainedwidth cw] 86 set modw [Widget::hasChanged $path -areawidth w] 87 if { $modcw || (!$cw && $modw) } { 88 if { $cw } { 89 set w [winfo width $path] 90 } 91 set upd 1 92 } 93 94 set modch [Widget::hasChanged $path -constrainedheight ch] 95 set modh [Widget::hasChanged $path -areaheight h] 96 if { $modch || (!$ch && $modh) } { 97 if { $ch } { 98 set h [winfo height $path] 99 } 100 set upd 1 101 } 102 103 if { $upd } { 104 $path:cmd itemconfigure win -width $w -height $h 105 } 106 return $res 107} 108 109 110# ---------------------------------------------------------------------------- 111# Command ScrollableFrame::cget 112# ---------------------------------------------------------------------------- 113proc ScrollableFrame::cget { path option } { 114 return [Widget::cget $path $option] 115} 116 117 118# ---------------------------------------------------------------------------- 119# Command ScrollableFrame::getframe 120# ---------------------------------------------------------------------------- 121proc ScrollableFrame::getframe { path } { 122 return $path.frame 123} 124 125# ---------------------------------------------------------------------------- 126# Command ScrollableFrame::see 127# ---------------------------------------------------------------------------- 128proc ScrollableFrame::see { path widget {vert top} {horz left} {xOffset 0} {yOffset 0}} { 129 set x0 [winfo x $widget] 130 set y0 [winfo y $widget] 131 set x1 [expr {$x0+[winfo width $widget]}] 132 set y1 [expr {$y0+[winfo height $widget]}] 133 set xb0 [$path:cmd canvasx 0] 134 set yb0 [$path:cmd canvasy 0] 135 set xb1 [$path:cmd canvasx [winfo width $path]] 136 set yb1 [$path:cmd canvasy [winfo height $path]] 137 set dx 0 138 set dy 0 139 140 if { [string equal $horz "left"] } { 141 if { $x1 > $xb1 } { 142 set dx [expr {$x1-$xb1}] 143 } 144 if { $x0 < $xb0+$dx } { 145 set dx [expr {$x0-$xb0}] 146 } 147 } elseif { [string equal $horz "right"] } { 148 if { $x0 < $xb0 } { 149 set dx [expr {$x0-$xb0}] 150 } 151 if { $x1 > $xb1+$dx } { 152 set dx [expr {$x1-$xb1}] 153 } 154 } 155 156 if { [string equal $vert "top"] } { 157 if { $y1 > $yb1 } { 158 set dy [expr {$y1-$yb1}] 159 } 160 if { $y0 < $yb0+$dy } { 161 set dy [expr {$y0-$yb0}] 162 } 163 } elseif { [string equal $vert "bottom"] } { 164 if { $y0 < $yb0 } { 165 set dy [expr {$y0-$yb0}] 166 } 167 if { $y1 > $yb1+$dy } { 168 set dy [expr {$y1-$yb1}] 169 } 170 } 171 172 if {($dx + $xOffset) != 0} { 173 set x [expr {($xb0+$dx+$xOffset)/[winfo width $path.frame]}] 174 $path:cmd xview moveto $x 175 } 176 if {($dy + $yOffset) != 0} { 177 set y [expr {($yb0+$dy+$yOffset)/[winfo height $path.frame]}] 178 $path:cmd yview moveto $y 179 } 180} 181 182 183# ---------------------------------------------------------------------------- 184# Command ScrollableFrame::xview 185# ---------------------------------------------------------------------------- 186proc ScrollableFrame::xview { path args } { 187 return [eval [list $path:cmd xview] $args] 188} 189 190 191# ---------------------------------------------------------------------------- 192# Command ScrollableFrame::yview 193# ---------------------------------------------------------------------------- 194proc ScrollableFrame::yview { path args } { 195 return [eval [list $path:cmd yview] $args] 196} 197 198 199# ---------------------------------------------------------------------------- 200# Command ScrollableFrame::_resize 201# ---------------------------------------------------------------------------- 202proc ScrollableFrame::_resize { path } { 203 if { [Widget::getoption $path -constrainedwidth] } { 204 $path:cmd itemconfigure win -width [winfo width $path] 205 } 206 if { [Widget::getoption $path -constrainedheight] } { 207 $path:cmd itemconfigure win -height [winfo height $path] 208 } 209} 210 211 212# ---------------------------------------------------------------------------- 213# Command ScrollableFrame::_frameConfigure 214# ---------------------------------------------------------------------------- 215proc ScrollableFrame::_frameConfigure {canvas frame width height} { 216 # This ensures that we don't get funny scrollability in the frame 217 # when it is smaller than the canvas space 218 if {[winfo height $frame] < [winfo height $canvas]} { 219 set height [winfo height $canvas] 220 } 221 if {[winfo width $frame] < [winfo width $canvas]} { 222 set width [winfo width $canvas] 223 } 224 $canvas:cmd configure -scrollregion [list 0 0 $width $height] 225} 226