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
61
62
63
64
65
66
67
68
69
70
71
|
# copyright (C) 1997-2005 Jean-Luc Fontaine (mailto:jfontain@free.fr)
# this program is free software: please read the COPYRIGHT file enclosed in this package or use the Help Copyright menu
# $Id: scrollbl.tcl,v 2.13 2005/01/02 00:45:07 jfontain Exp $
class scrollingLabel {
proc scrollingLabel {this parentPath args} composite {[new frame $parentPath] $args} {
# anchor label for proper behavior with multi-line messages
composite::manage $this [new label $widget::($this,path) -font $widget::option(button,font) -justify left] label
composite::complete $this
bind $widget::($this,path) <Configure> "scrollingLabel::refresh $this %w" ;# now that everything is initialized properly
}
proc ~scrollingLabel {this} {}
proc options {this} { ;# force text and step initialization
return [list\
[list -font $widget::option(button,font) $widget::option(button,font)]\
[list -interval 15 15]\
[list -step 1]\
[list -text {}]\
[list -width 0 0]\
]
}
proc set-interval {this value} {}
proc set-step {this value} {
set ($this,step) -$value ;# start moving left
}
proc set-font {this value} {
$composite::($this,label,path) configure -font $value
refresh $this [winfo width $widget::($this,path)] ;# force refresh
}
proc set-text {this value} {
$composite::($this,label,path) configure -text $value
refresh $this [winfo width $widget::($this,path)] ;# force refresh
}
proc set-width {this value} {
$widget::($this,path) configure -width $value
}
proc refresh {this width} {
if {![info exists ($this,step)]} return ;# not initialized yet
set ($this,textWidth) [winfo reqwidth $composite::($this,label,path)]
$widget::($this,path) configure -height [winfo reqheight $composite::($this,label,path)]
place $composite::($this,label,path) -anchor nw -x [set ($this,x) 0] -y 0
if {$width < $($this,textWidth)} { ;# scrolling required
scroll $this $width
} else {
catch {after cancel $($this,event)}
}
}
proc scroll {this width} {
set interval $composite::($this,-interval)
if {(($($this,step) < 0) && ($($this,x) < ($width - $($this,textWidth)))) || (($($this,step) > 0) && ($($this,x) > 0))} {
set ($this,step) [expr {-$($this,step)}] ;# change direction
set interval [expr {20 * $interval}] ;# pause a while
}
place $composite::($this,label,path) -x [incr ($this,x) $($this,step)]
catch {after cancel $($this,event)} ;# avoid race conditions
set ($this,event) [after $interval "scrollingLabel::scroll $this $width"]
}
}
|
