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
72
73
74
75
76
|
# 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: imagelab.tcl,v 1.4 2005/01/02 00:45:07 jfontain Exp $
class imageLabel {
proc imageLabel {this parentPath args} composite {[new frame $parentPath] $args} {
set path $widget::($this,path)
composite::manage $this [new label $path] label [new label $path] image
place $composite::($this,image,path) -relx 1 -rely 0.5 -anchor e
bind $composite::($this,label,path) <Configure> "imageLabel::update $this"
bind $composite::($this,image,path) <Configure> "imageLabel::update $this"
composite::complete $this
}
proc ~imageLabel {this} {}
proc options {this} {
return [list\
[list -bindtags {} {}]\
[list -font $widget::option(label,font) $widget::option(label,font)]\
[list -image {} {}]\
[list -text {} {}]\
[list -width 0 0]\
]
}
proc set-bindtags {this value} {
if {$composite::($this,complete)} {
error {option -bindtags cannot be set dynamically}
}
set path $composite::($this,label,path); bindtags $path [concat [bindtags $path] $value]
set path $composite::($this,image,path); bindtags $path [concat [bindtags $path] $value]
}
proc set-font {this value} {
$composite::($this,label,path) configure -font $value
}
proc set-image {this value} {
$composite::($this,image,path) configure -image $value
}
proc set-text {this value} {
$composite::($this,label,path) configure -text $value
}
proc set-width {this value} {
if {$value == 0} {
update $this
} else {
$widget::($this,path) configure -width $value
}
}
proc update {this} {
set height 0
set label $composite::($this,label,path); set image $composite::($this,image,path)
if {[set value [winfo reqheight $label]] > $height} {set height $value}
if {[set value [winfo reqheight $image]] > $height} {set height $value}
$widget::($this,path) configure -height $height
set labelWidth [winfo reqwidth $label]; set imageWidth [winfo reqwidth $image]
set width [winfo width $widget::($this,path)] ;# actual width
if {($labelWidth + $imageWidth) < $width} {
place $label -anchor e -relx 1 -x -$imageWidth -rely 0.5 ;# flush right with image
} else {
place $label -anchor w -relx 0 -x 0 -rely 0.5 ;# with leftmost part always visible
}
if {$composite::($this,-width) == 0} { ;# automatic sizing
$widget::($this,path) configure -width [expr {$labelWidth + $imageWidth}]
}
}
}
|
