SGrid1.tcl
5.3 KB
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
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
# -*-mode: tcl; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: SGrid1.tcl,v 1.3 2001/12/09 05:31:07 idiscovery Exp $
#
# Tix Demostration Program
#
# This sample program is structured in such a way so that it can be
# executed from the Tix demo program "widget": it must have a
# procedure called "RunSample". It should also have the "if" statment
# at the end of this file so that it can be run as a standalone
# program using tixwish.
# Demonstrates the tixGrid widget
#
proc RunSample {w} {
wm title $w "Doe Inc. Performance"
wm geometry $w 640x300
set top [frame $w.f -bd 1 -relief raised]
set box [tixButtonBox $w.b -bd 1 -relief raised]
pack $box -side bottom -fill both
pack $top -side top -fill both -expand yes
label $top.lab -text "This widget is still under alpha
Please ignore the debug messages
Not all features have been implemented" -justify left
pack $top.lab -side top -anchor c -padx 3 -pady 3
MakeGrid $top
# Create the buttons
#
$box add ok -text Ok -command "destroy $w" -width 6
$box add cancel -text Cancel -command "destroy $w" -width 6
}
# This command is called whenever the background of the grid needs to
# be reformatted. The x1, y1, x2, y2 sprcifies the four corners of the area
# that needs to be reformatted.
#
proc gformat {w area x1 y1 x2 y2} {
set bg(s-margin) gray65
set bg(x-margin) gray65
set bg(y-margin) gray65
set bg(main) gray20
case $area {
main {
for {set y [expr ($y1/2) * 2]} {$y <= $y2} {incr y 2} {
$w format border $x1 $y $x2 $y \
-relief flat -filled 1\
-bd 0 -bg #80b080 -selectbackground #80b0ff
}
$w format grid $x1 $y1 $x2 $y2 \
-relief raised -bd 1 -bordercolor $bg($area) -filled 0 -bg red\
-xon 1 -yon 1 -xoff 0 -yoff 0 -anchor se
}
y-margin {
$w format border $x1 $y1 $x2 $y2 \
-fill 1 -relief raised -bd 1 -bg $bg($area) \
-selectbackground gray80
}
default {
$w format border $x1 $y1 $x2 $y2 \
-filled 1 \
-relief raised -bd 1 -bg $bg($area) \
-selectbackground gray80
}
}
}
# Print a number in $ format
#
#
proc Dollar {s} {
set n [string len $s]
set start [expr $n % 3]
if {$start == 0} {
set start 3
}
set str ""
for {set i 0} {$i < $n} {incr i} {
if {$start == 0} {
append str ","
set start 3
}
incr start -1
append str [string index $s $i]
}
return $str
}
proc MakeGrid {w} {
# data format {year revenue profit}
#
set data {
{1970 1000000000 1000000}
{1971 1100000000 2000000}
{1972 1200000000 3000000}
{1973 1300000000 4000000}
{1974 1400000000 5000000}
{1975 1500000000 6000000}
{1976 1600000000 7000000}
{1977 1700000000 8000000}
{1978 1800000000 9000000}
{1979 1900000000 10000000}
{1980 2000000000 11000000}
{1981 2100000000 22000000}
{1982 2200000000 33000000}
{1983 2300000000 44000000}
{1984 2400000000 55000000}
{1985 3500000000 36000000}
{1986 4600000000 57000000}
{1987 5700000000 68000000}
{1988 6800000000 79000000}
{1989 7900000000 90000000}
{1990 13000000000 111000000}
{1991 14100000000 122000000}
{1992 16200000000 233000000}
{1993 28300000000 344000000}
{1994 29400000000 455000000}
{1995 38500000000 536000000}
}
set headers {
"Revenue ($)"
"Rev. Growth (%)"
"Profit ($)"
"Profit Growth (%)"
}
# Create the grid
#
tixScrolledGrid $w.g -bd 0
pack $w.g -expand yes -fill both -padx 3 -pady 3
set grid [$w.g subwidget grid]
$grid config -formatcmd "gformat $grid"
# Set the size of the columns
#
$grid size col 0 -size 10char
$grid size col 1 -size auto
$grid size col 2 -size auto
$grid size col 3 -size auto
$grid size col 4 -size auto
# set the default size of the column and rows. these sizes will be used
# if the size of a row or column has not be set via the "size col ?"
# command
$grid size col default -size 5char
$grid size row default -size 1.1char -pad0 3
set margin [tixDisplayStyle text -refwindow $grid \
-anchor c -padx 3 -font [tix option get bold_font]]
set dollar [tixDisplayStyle text -refwindow $grid \
-anchor e]
# Create the headers
#
set x 1
foreach h $headers {
$grid set $x 0 -itemtype text -text $h -style $margin
incr x
}
# Insert the data, year by year
#
set lastRevn {}
set lastProf {}
set i 1
foreach line $data {
set year [lindex $line 0]
set revn [lindex $line 1]
set prof [lindex $line 2]
if {$lastRevn != {}} {
set rgrowth \
[format %4.2f [expr ($revn.0-$lastRevn)/$lastRevn*100.0]]
} else {
set rgrowth "-"
}
if {$lastProf != {}} {
set pgrowth \
[format %4.2f [expr ($prof.0-$lastProf)/$lastProf*100.0]]
} else {
set pgrowth "-"
}
$grid set 0 $i -itemtype text -style $margin -text $year
$grid set 1 $i -itemtype text -style $dollar -text [Dollar $revn]
$grid set 2 $i -itemtype text -style $dollar -text $rgrowth
$grid set 3 $i -itemtype text -style $dollar -text [Dollar $prof]
$grid set 4 $i -itemtype text -style $dollar -text $pgrowth
set lastRevn $revn.0
set lastProf $prof.0
incr i
}
}
if {![info exists tix_demo_running]} {
wm withdraw .
set w .demo
toplevel $w; wm transient $w ""
RunSample $w
bind $w <Destroy> exit
}