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