1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
|
# $Id: scroller.tcl,v 2.3 2002/05/30 17:11:45 jfontain Exp $
class scroller {
proc scroller {this parentPath args} composite {[new scroll canvas $parentPath] $args} {
set ($this,canvasPath) $composite::($composite::($this,base),scrolled,path)
composite::complete $this
}
# displayed widget must be destroyed by user as it may be the path of a scwoop widget, which could be deleted elsewhere
proc ~scroller {this} {}
proc options {this} {
return [list\
[list\
-scrollbarelementborderwidth\
$widget::option(scrollbar,elementborderwidth) $widget::option(scrollbar,elementborderwidth)\
]\
[list -height 0 0]\
[list -width 0 0]\
[list -xscrollincrement $widget::option(canvas,xscrollincrement) $widget::option(canvas,xscrollincrement)]\
[list -yscrollincrement $widget::option(canvas,yscrollincrement) $widget::option(canvas,yscrollincrement)]\
]
}
proc display {this path} {
if {[string length $path]==0} { ;# undisplay, remove related resources
$($this,canvasPath) delete all
bind $($this,displayed) <Configure> {}
catch {unset ($this,displayed)}
return
}
if {[info exists ($this,displayed)]} {
error "scroller \"$this\" already displays widget \"$($this,displayed)\""
}
if {![string equal $widget::($this,path) [winfo parent $path]]} {
error "displayed widget \"$path\" must be a child of scroller \"$this\" path"
}
set ($this,displayed) $path
set canvas $($this,canvasPath)
raise $path $canvas ;# always make sure widget is visible
$canvas create window 0 0 -window $path -anchor nw
# handle displayed widget dynamic size changes
bind $path <Configure> "$canvas configure -width %w -height %h -scrollregion {0 0 %w %h}"
}
foreach option {-scrollbarelementborderwidth -height -width} {
proc set$option {this value} "composite::configure \$composite::(\$this,base) $option \$value"
}
proc set-xscrollincrement {this value} {
$($this,canvasPath) configure -xscrollincrement $value
}
proc set-yscrollincrement {this value} {
$($this,canvasPath) configure -yscrollincrement $value
}
}
|
