gooderp18绿色标准版
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

216 lines
5.3KB

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