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