source: trunk/BWidget-1.2.1/scrollview.tcl @ 984

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

include rest of files
File size: 9.5 KB
Line 
1# ------------------------------------------------------------------------------
2#  scrollview.tcl
3#  This file is part of Unifix BWidget Toolkit
4#  $Id: scrollview.tcl,v 1.2 1999/05/10 14:10:32 eric Exp $
5# ------------------------------------------------------------------------------
6#  Index of commands:
7#     - ScrolledWindow::create
8#     - ScrolledWindow::configure
9#     - ScrolledWindow::cget
10#     - ScrolledWindow::_set_hscroll
11#     - ScrolledWindow::_set_vscroll
12#     - ScrolledWindow::_update_scroll
13#     - ScrolledWindow::_set_view
14#     - ScrolledWindow::_resize
15# ------------------------------------------------------------------------------
16
17namespace eval ScrollView {
18    Widget::declare ScrollView {
19        {-width       TkResource 30        0 canvas}
20        {-height      TkResource 30        0 canvas}
21        {-background  TkResource ""        0 canvas}
22        {-foreground  String     black     0}
23        {-fill        String     ""        0}
24        {-relief      TkResource flat      0 canvas}
25        {-borderwidth TkResource 0         0 canvas}
26        {-cursor      TkResource crosshair 0 canvas}
27        {-window      String     ""        0}
28        {-fg          Synonym    -foreground}
29        {-bg          Synonym    -background}
30        {-bd          Synonym    -borderwidth}
31    }
32
33    Widget::addmap ScrollView "" :cmd \
34        {-relief {} -borderwidth {} -background {} -width {} -height {} -cursor {}}
35
36    bind BwScrollView <ButtonPress-3> {ScrollView::_set_view %W set %x %y}
37    bind BwScrollView <ButtonPress-1> {ScrollView::_set_view %W start %x %y}
38    bind BwScrollView <B1-Motion>     {ScrollView::_set_view %W motion %x %y}
39    bind BwScrollView <Configure>     {ScrollView::_resize %W}
40    bind BwScrollView <Destroy>       {ScrollView::_destroy %W}
41
42    proc ::ScrollView { path args } { return [eval ScrollView::create $path $args] }
43    proc use {} {}
44
45    variable _widget
46}
47
48
49# ------------------------------------------------------------------------------
50#  Command ScrollView::create
51# ------------------------------------------------------------------------------
52proc ScrollView::create { path args } {
53    variable _widget
54
55    Widget::init ScrollView $path $args
56
57    set w                     [Widget::getoption $path -window]
58    set _widget($path,bd)     [Widget::getoption $path -borderwidth]
59    set _widget($path,width)  [Widget::getoption $path -width]
60    set _widget($path,height) [Widget::getoption $path -height]
61
62    if { [winfo exists $w] } {
63        set _widget($path,oldxscroll) [$w cget -xscrollcommand]
64        set _widget($path,oldyscroll) [$w cget -yscrollcommand]
65        $w configure \
66            -xscrollcommand "ScrollView::_set_hscroll $path" \
67            -yscrollcommand "ScrollView::_set_vscroll $path"
68    }
69    eval canvas $path [Widget::subcget $path :cmd] -highlightthickness 0
70    $path create rectangle -2 -2 -2 -2 \
71        -fill    [Widget::getoption $path -fill]       \
72        -outline [Widget::getoption $path -foreground] \
73        -tags    view
74
75    bindtags $path [list $path BwScrollView [winfo toplevel $path] all]
76
77    rename $path ::$path:cmd
78    proc ::$path { cmd args } "return \[eval ScrollView::\$cmd $path \$args\]"
79
80    return $path
81}
82
83
84# ------------------------------------------------------------------------------
85#  Command ScrollView::configure
86# ------------------------------------------------------------------------------
87proc ScrollView::configure { path args } {
88    variable _widget
89
90    set oldw [Widget::getoption $path -window] 
91    set res  [Widget::configure $path $args]
92
93    if { [Widget::hasChanged $path -window w] } {
94        if { [winfo exists $oldw] } {
95            $oldw configure \
96                -xscrollcommand $_widget($path,oldxscroll) \
97                -yscrollcommand $_widget($path,oldyscroll)
98        }
99        if { [winfo exists $w] } {
100            set _widget($path,oldxscroll) [$w cget -xscrollcommand]
101            set _widget($path,oldyscroll) [$w cget -yscrollcommand]
102            $w configure \
103                -xscrollcommand "ScrollView::_set_hscroll $path" \
104                -yscrollcommand "ScrollView::_set_vscroll $path"
105        } else {
106            $path:cmd coords view -2 -2 -2 -2
107            set _widget($path,oldxscroll) {}
108            set _widget($path,oldyscroll) {}
109        }
110    }
111
112    if { [Widget::hasChanged $path -fill fill] |
113         [Widget::hasChanged $path -foreground fg] } {
114        $path:cmd itemconfigure view \
115            -fill    $fill \
116            -outline $fg
117    }
118
119    return $res
120}
121
122
123# ------------------------------------------------------------------------------
124#  Command ScrollView::cget
125# ------------------------------------------------------------------------------
126proc ScrollView::cget { path option } {
127    return [Widget::cget $path $option]
128}
129
130
131# ------------------------------------------------------------------------------
132#  Command ScrollView::_destroy
133# ------------------------------------------------------------------------------
134proc ScrollView::_destroy { path } {
135    variable _widget
136
137    set w [Widget::getoption $path -window] 
138    if { [winfo exists $w] } {
139        $w configure \
140            -xscrollcommand $_widget($path,oldxscroll) \
141            -yscrollcommand $_widget($path,oldyscroll)
142    }
143    unset _widget($path,oldxscroll)
144    unset _widget($path,oldyscroll)
145    unset _widget($path,bd)
146    unset _widget($path,width)
147    unset _widget($path,height)
148    catch {unset _widget($path,dx)}
149    catch {unset _widget($path,dy)}
150    Widget::destroy $path
151    rename $path {}
152}
153
154
155# ------------------------------------------------------------------------------
156#  Command ScrollView::_set_hscroll
157# ------------------------------------------------------------------------------
158proc ScrollView::_set_hscroll { path vmin vmax } {
159    variable _widget
160
161    set c  [$path:cmd coords view]
162    set x0 [expr {$vmin*$_widget($path,width)+$_widget($path,bd)}]
163    set x1 [expr {$vmax*$_widget($path,width)+$_widget($path,bd)-1}]
164    $path:cmd coords view $x0 [lindex $c 1] $x1 [lindex $c 3]
165    if { $_widget($path,oldxscroll) != "" } {
166        uplevel \#0 $_widget($path,oldxscroll) $vmin $vmax
167    }
168}
169
170
171# ------------------------------------------------------------------------------
172#  Command ScrollView::_set_vscroll
173# ------------------------------------------------------------------------------
174proc ScrollView::_set_vscroll { path vmin vmax } {
175    variable _widget
176
177    set c  [$path:cmd coords view]
178    set y0 [expr {$vmin*$_widget($path,height)+$_widget($path,bd)}]
179    set y1 [expr {$vmax*$_widget($path,height)+$_widget($path,bd)-1}]
180    $path:cmd coords view [lindex $c 0] $y0 [lindex $c 2] $y1
181    if { $_widget($path,oldyscroll) != "" } {
182        uplevel \#0 $_widget($path,oldyscroll) $vmin $vmax
183    }
184}
185
186
187# ------------------------------------------------------------------------------
188#  Command ScrollView::_update_scroll
189# ------------------------------------------------------------------------------
190proc ScrollView::_update_scroll { path callscroll hminmax vminmax } {
191    variable _widget
192
193    set c    [$path:cmd coords view]
194    set hmin [lindex $hminmax 0]
195    set hmax [lindex $hminmax 1]
196    set vmin [lindex $vminmax 0]
197    set vmax [lindex $vminmax 1]
198    set x0   [expr {$hmin*$_widget($path,width)+$_widget($path,bd)}]
199    set x1   [expr {$hmax*$_widget($path,width)+$_widget($path,bd)-1}]
200    set y0   [expr {$vmin*$_widget($path,height)+$_widget($path,bd)}]
201    set y1   [expr {$vmax*$_widget($path,height)+$_widget($path,bd)-1}]
202    $path:cmd coords view $x0 $y0 $x1 $y1
203    if { $callscroll } {
204        if { $_widget($path,oldxscroll) != "" } {
205            uplevel \#0 $_widget($path,oldxscroll) $hmin $hmax
206        }
207        if { $_widget($path,oldyscroll) != "" } {
208            uplevel \#0 $_widget($path,oldyscroll) $vmin $vmax
209        }
210    }
211}
212
213
214# ------------------------------------------------------------------------------
215#  Command ScrollView::_set_view
216# ------------------------------------------------------------------------------
217proc ScrollView::_set_view { path cmd x y } {
218    variable _widget
219
220    set w [Widget::getoption $path -window]
221    if { [winfo exists $w] } {
222        if { ![string compare $cmd "start"] } {
223            set c  [$path:cmd coords view]
224            set x0 [lindex $c 0]
225            set y0 [lindex $c 1]
226            set _widget($path,dx) [expr {$x-$x0}]
227            set _widget($path,dy) [expr {$y-$y0}]
228        } else {
229            if { ![string compare $cmd "motion"] } {
230                set vh [expr {double($x-$_widget($path,dx)-$_widget($path,bd))/$_widget($path,width)}]
231                set vv [expr {double($y-$_widget($path,dy)-$_widget($path,bd))/$_widget($path,height)}]
232            } else {
233                set vh [expr {double($x-$_widget($path,bd))/$_widget($path,width)}]
234                set vv [expr {double($y-$_widget($path,bd))/$_widget($path,height)}]
235            }
236            $w xview moveto $vh
237            $w yview moveto $vv
238            _update_scroll $path 1 [$w xview] [$w yview]
239        }
240    }
241}
242
243
244# ------------------------------------------------------------------------------
245#  Command ScrollView::_resize
246# ------------------------------------------------------------------------------
247proc ScrollView::_resize { path } {
248    variable _widget
249
250    set _widget($path,bd)     [Widget::getoption $path -borderwidth]
251    set _widget($path,width)  [expr {[winfo width  $path]-2*$_widget($path,bd)}]
252    set _widget($path,height) [expr {[winfo height $path]-2*$_widget($path,bd)}]
253    set w [Widget::getoption $path -window]
254    if { [winfo exists $w] } {
255        _update_scroll $path 0 [$w xview] [$w yview]
256    }
257}
Note: See TracBrowser for help on using the repository browser.