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