source: trunk/BWidget-1.2.1/scrollframe.tcl @ 931

Last change on this file since 931 was 931, checked in by toby, 11 years ago

include rest of files

File size: 6.7 KB
RevLine 
[931]1# ------------------------------------------------------------------------------
2#  scrollframe.tcl
3#  This file is part of Unifix BWidget Toolkit
4#  $Id: scrollframe.tcl,v 1.3 1999/07/09 08:10:36 eric 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> "$canvas:cmd configure -scrollregion {0 0 %w %h}"
67    bindtags $path [list $path BwScrollableFrame [winfo toplevel $path] all]
68
69    rename $path ::$path:cmd
70    proc ::$path { cmd args } "return \[eval ScrollableFrame::\$cmd $path \$args\]"
71
72    return $canvas
73}
74
75
76# ------------------------------------------------------------------------------
77#  Command ScrollableFrame::configure
78# ------------------------------------------------------------------------------
79proc ScrollableFrame::configure { path args } {
80    set res [Widget::configure $path $args]
81    set upd 0
82
83    set modcw [Widget::hasChanged $path -constrainedwidth cw]
84    set modw  [Widget::hasChanged $path -areawidth w]
85    if { $modcw || (!$cw && $modw) } {
86        if { $cw } {
87            set w [winfo width $path]
88        }
89        set upd 1
90    }
91
92    set modch [Widget::hasChanged $path -constrainedheight ch]
93    set modh  [Widget::hasChanged $path -areaheight h]
94    if { $modch || (!$ch && $modh) } {
95        if { $ch } {
96            set h [winfo height $path]
97        }
98        set upd 1
99    }
100
101    if { $upd } {
102        $path:cmd itemconfigure win -width $w -height $h
103    }
104    return $res
105}
106
107
108# ------------------------------------------------------------------------------
109#  Command ScrollableFrame::cget
110# ------------------------------------------------------------------------------
111proc ScrollableFrame::cget { path option } {
112    return [Widget::cget $path $option]
113}
114
115
116# ------------------------------------------------------------------------------
117#  Command ScrollableFrame::getframe
118# ------------------------------------------------------------------------------
119proc ScrollableFrame::getframe { path } {
120    return $path.frame
121}
122
123
124# ------------------------------------------------------------------------------
125#  Command ScrollableFrame::see
126# ------------------------------------------------------------------------------
127proc ScrollableFrame::see { path widget {vert top} {horz left}} {
128    set x0  [winfo x $widget]
129    set y0  [winfo y $widget]
130    set x1  [expr {$x0+[winfo width  $widget]}]
131    set y1  [expr {$y0+[winfo height $widget]}]
132    set xb0 [$path:cmd canvasx 0]
133    set yb0 [$path:cmd canvasy 0]
134    set xb1 [$path:cmd canvasx [winfo width  $path]]
135    set yb1 [$path:cmd canvasy [winfo height $path]]
136    set dx  0
137    set dy  0
138
139    if { ![string compare $horz "left"] } {
140        if { $x1 > $xb1 } {
141            set dx [expr {$x1-$xb1}]
142        }
143        if { $x0 < $xb0+$dx } {
144            set dx [expr {$x0-$xb0}]
145        }
146    } elseif { ![string compare $horz "right"] } {
147        if { $x0 < $xb0 } {
148            set dx [expr {$x0-$xb0}]
149        }
150        if { $x1 > $xb1+$dx } {
151            set dx [expr {$x1-$xb1}]
152        }
153    }
154
155    if { ![string compare $vert "top"] } {
156        if { $y1 > $yb1 } {
157            set dy [expr {$y1-$yb1}]
158        }
159        if { $y0 < $yb0+$dy } {
160            set dy [expr {$y0-$yb0}]
161        }
162    } elseif { ![string compare $vert "bottom"] } {
163        if { $y0 < $yb0 } {
164            set dy [expr {$y0-$yb0}]
165        }
166        if { $y1 > $yb1+$dy } {
167            set dy [expr {$y1-$yb1}]
168        }
169    }
170
171    if { $dx != 0 } {
172        set x [expr {($xb0+$dx)/[winfo width $path.frame]}]
173        $path:cmd xview moveto $x
174    }
175    if { $dy != 0 } {
176        set y [expr {($yb0+$dy)/[winfo height $path.frame]}]
177        $path:cmd yview moveto $y
178    }
179}
180
181
182# ------------------------------------------------------------------------------
183#  Command ScrollableFrame::xview
184# ------------------------------------------------------------------------------
185proc ScrollableFrame::xview { path args } {
186    return [eval $path:cmd xview $args]
187}
188
189
190# ------------------------------------------------------------------------------
191#  Command ScrollableFrame::yview
192# ------------------------------------------------------------------------------
193proc ScrollableFrame::yview { path args } {
194    return [eval $path:cmd yview $args]
195}
196
197
198# ------------------------------------------------------------------------------
199#  Command ScrollableFrame::_resize
200# ------------------------------------------------------------------------------
201proc ScrollableFrame::_resize { path } {
202    if { [Widget::getoption $path -constrainedwidth] } {
203        $path:cmd itemconfigure win -width [winfo width $path]
204    }
205    if { [Widget::getoption $path -constrainedheight] } {
206        $path:cmd itemconfigure win -height [winfo height $path]
207    }
208}
209
210
Note: See TracBrowser for help on using the repository browser.