1# ---------------------------------------------------------------------------- 2# scrollframe.tcl 3# This file is part of Unifix BWidget Toolkit 4# $Id: scrollframe.tcl,v 1.14 2009/10/27 22:15:09 oberdorfer 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# - ScrollableFrame::_themechanged 16# ---------------------------------------------------------------------------- 17 18namespace eval ScrollableFrame { 19 Widget::define ScrollableFrame scrollframe 20 21 Widget::declare ScrollableFrame { 22 {-background Color "SystemWindowFrame" 0} 23 {-width Int 0 0 {}} 24 {-height Int 0 0 {}} 25 {-areawidth Int 0 0 {}} 26 {-areaheight Int 0 0 {}} 27 {-constrainedwidth Boolean 0 0} 28 {-constrainedheight Boolean 0 0} 29 {-xscrollcommand TkResource "" 0 canvas} 30 {-yscrollcommand TkResource "" 0 canvas} 31 {-xscrollincrement TkResource "" 0 canvas} 32 {-yscrollincrement TkResource "" 0 canvas} 33 {-bg Synonym -background} 34 } 35 36 Widget::addmap ScrollableFrame "" :cmd { 37 -width {} -height {} 38 -xscrollcommand {} -yscrollcommand {} 39 -xscrollincrement {} -yscrollincrement {} 40 } 41 42 variable _widget 43 44 bind BwScrollableFrame <Configure> [list ScrollableFrame::_resize %W] 45 bind BwScrollableFrame <Destroy> [list Widget::destroy %W] 46 47 if {[lsearch [bindtags .] ScrollableFrameThemeChanged] < 0} { 48 bindtags . [linsert [bindtags .] 1 ScrollableFrameThemeChanged] 49 } 50} 51 52 53# ---------------------------------------------------------------------------- 54# Command ScrollableFrame::create 55# ---------------------------------------------------------------------------- 56proc ScrollableFrame::create { path args } { 57 Widget::init ScrollableFrame $path $args 58 59 set bg [Widget::cget $path -background] 60 61 set canvas [eval [list canvas $path] [Widget::subcget $path :cmd] \ 62 -highlightthickness 0 -borderwidth 0 -relief flat \ 63 -bg $bg] 64 65 set frame [eval [list frame $path.frame] \ 66 -highlightthickness 0 -borderwidth 0 -relief flat \ 67 -background $bg] 68 69 $canvas create window 0 0 -anchor nw -window $frame -tags win \ 70 -width [Widget::cget $path -areawidth] \ 71 -height [Widget::cget $path -areaheight] 72 73 bind $frame <Configure> \ 74 [list ScrollableFrame::_frameConfigure $canvas] 75 # add <unmap> binding: <configure> is not called when frame 76 # becomes so small that it suddenly falls outside of currently visible area. 77 # but now we need to add a <map> binding too 78 bind $frame <Map> \ 79 [list ScrollableFrame::_frameConfigure $canvas] 80 bind $frame <Unmap> \ 81 [list ScrollableFrame::_frameConfigure $canvas 1] 82 83 bindtags $path [list $path BwScrollableFrame [winfo toplevel $path] all] 84 85 bind ScrollableFrameThemeChanged <<ThemeChanged>> \ 86 "+ [namespace current]::_themechanged $path" 87 88 return [Widget::create ScrollableFrame $path] 89} 90 91 92# ---------------------------------------------------------------------------- 93# Command ScrollableFrame::configure 94# ---------------------------------------------------------------------------- 95proc ScrollableFrame::configure { path args } { 96 set res [Widget::configure $path $args] 97 set upd 0 98 99 if { [Widget::hasChanged $path -background bg] } { 100 $path:cmd configure -background $bg 101 $path.frame configure -background $bg 102 } 103 104 set modcw [Widget::hasChanged $path -constrainedwidth cw] 105 set modw [Widget::hasChanged $path -areawidth w] 106 if { $modcw || (!$cw && $modw) } { 107 if { $cw } { 108 set w [winfo width $path] 109 } 110 set upd 1 111 } 112 113 set modch [Widget::hasChanged $path -constrainedheight ch] 114 set modh [Widget::hasChanged $path -areaheight h] 115 if { $modch || (!$ch && $modh) } { 116 if { $ch } { 117 set h [winfo height $path] 118 } 119 set upd 1 120 } 121 122 if { $upd } { 123 $path:cmd itemconfigure win -width $w -height $h 124 } 125 return $res 126} 127 128 129# ---------------------------------------------------------------------------- 130# Command ScrollableFrame::cget 131# ---------------------------------------------------------------------------- 132proc ScrollableFrame::cget { path option } { 133 return [Widget::cget $path $option] 134} 135 136 137# ---------------------------------------------------------------------------- 138# Command ScrollableFrame::getframe 139# ---------------------------------------------------------------------------- 140proc ScrollableFrame::getframe { path } { 141 return $path.frame 142} 143 144# ---------------------------------------------------------------------------- 145# Command ScrollableFrame::see 146# ---------------------------------------------------------------------------- 147proc ScrollableFrame::see { path widget {vert top} {horz left} {xOffset 0} {yOffset 0}} { 148 set x0 [winfo x $widget] 149 set y0 [winfo y $widget] 150 set x1 [expr {$x0+[winfo width $widget]}] 151 set y1 [expr {$y0+[winfo height $widget]}] 152 set xb0 [$path:cmd canvasx 0] 153 set yb0 [$path:cmd canvasy 0] 154 set xb1 [$path:cmd canvasx [winfo width $path]] 155 set yb1 [$path:cmd canvasy [winfo height $path]] 156 set dx 0 157 set dy 0 158 159 if { [string equal $horz "left"] } { 160 if { $x1 > $xb1 } { 161 set dx [expr {$x1-$xb1}] 162 } 163 if { $x0 < $xb0+$dx } { 164 set dx [expr {$x0-$xb0}] 165 } 166 } elseif { [string equal $horz "right"] } { 167 if { $x0 < $xb0 } { 168 set dx [expr {$x0-$xb0}] 169 } 170 if { $x1 > $xb1+$dx } { 171 set dx [expr {$x1-$xb1}] 172 } 173 } 174 175 if { [string equal $vert "top"] } { 176 if { $y1 > $yb1 } { 177 set dy [expr {$y1-$yb1}] 178 } 179 if { $y0 < $yb0+$dy } { 180 set dy [expr {$y0-$yb0}] 181 } 182 } elseif { [string equal $vert "bottom"] } { 183 if { $y0 < $yb0 } { 184 set dy [expr {$y0-$yb0}] 185 } 186 if { $y1 > $yb1+$dy } { 187 set dy [expr {$y1-$yb1}] 188 } 189 } 190 191 if {($dx + $xOffset) != 0} { 192 set x [expr {($xb0+$dx+$xOffset)/[winfo width $path.frame]}] 193 $path:cmd xview moveto $x 194 } 195 if {($dy + $yOffset) != 0} { 196 set y [expr {($yb0+$dy+$yOffset)/[winfo height $path.frame]}] 197 $path:cmd yview moveto $y 198 } 199} 200 201 202# ---------------------------------------------------------------------------- 203# Command ScrollableFrame::xview 204# ---------------------------------------------------------------------------- 205proc ScrollableFrame::xview { path args } { 206 return [eval [list $path:cmd xview] $args] 207} 208 209 210# ---------------------------------------------------------------------------- 211# Command ScrollableFrame::yview 212# ---------------------------------------------------------------------------- 213proc ScrollableFrame::yview { path args } { 214 return [eval [list $path:cmd yview] $args] 215} 216 217 218# ---------------------------------------------------------------------------- 219# Command ScrollableFrame::_resize 220# ---------------------------------------------------------------------------- 221proc ScrollableFrame::_resize { path } { 222 if { [Widget::getoption $path -constrainedwidth] } { 223 $path:cmd itemconfigure win -width [winfo width $path] 224 } 225 if { [Widget::getoption $path -constrainedheight] } { 226 $path:cmd itemconfigure win -height [winfo height $path] 227 } 228 # scollregion must also be reset when canvas size changes 229 _frameConfigure $path 230} 231 232 233# ---------------------------------------------------------------------------- 234# Command ScrollableFrame::_frameConfigure 235# ---------------------------------------------------------------------------- 236proc ScrollableFrame::_max {a b} {return [expr {$a <= $b ? $b : $a}]} 237proc ScrollableFrame::_frameConfigure {canvas {unmap 0}} { 238 # This ensures that we don't get funny scrollability in the frame 239 # when it is smaller than the canvas space 240 # use [winfo] to get height & width of frame 241 242 # [winfo] doesn't work for unmapped frame 243 set frameh [expr {$unmap ? 0 : [winfo height $canvas.frame]}] 244 set framew [expr {$unmap ? 0 : [winfo width $canvas.frame]}] 245 246 set height [_max $frameh [winfo height $canvas]] 247 set width [_max $framew [winfo width $canvas]] 248 249 $canvas:cmd configure -scrollregion [list 0 0 $width $height] 250} 251 252# ---------------------------------------------------------------------------- 253# Command ScrollableFrame::_themechanged 254# ---------------------------------------------------------------------------- 255proc ScrollableFrame::_themechanged { path } { 256 257 if { ![winfo exists $path] } { return } 258 BWidget::set_themedefaults 259 $path configure -background $BWidget::colors(SystemWindowFrame) 260} 261