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