butGeom.tcl
上传用户:rrhhcc
上传日期:2015-12-11
资源大小:54129k
文件大小:5k
源码类别:

通讯编程

开发平台:

Visual C++

  1. # This file creates a visual test for button layout.  It is part of
  2. # the Tk visual test suite, which is invoked via the "visual" script.
  3. #
  4. # RCS: @(#) $Id: butGeom.tcl,v 1.3 1999/04/16 01:51:34 stanton Exp $
  5. catch {destroy .t}
  6. toplevel .t
  7. wm title .t "Visual Tests for Button Geometry"
  8. wm iconname .t "Button Geometry"
  9. wm geom .t +0+0
  10. wm minsize .t 1 1
  11. label .t.l -text {This screen exercises the layout mechanisms for various flavors of buttons.  Select display options below, and they will be applied to all of the button widgets.  In order to see the effects of different anchor positions, expand the window so that there is extra space in the buttons.  The letter "o" in "automatically" should be underlined in the right column of widgets.} -wraplength 5i
  12. pack .t.l -side top -fill both
  13. button .t.quit -text Quit -command {destroy .t}
  14. pack .t.quit -side bottom -pady 2m
  15. set sepId 1
  16. proc sep {} {
  17.     global sepId
  18.     frame .t.sep$sepId -height 2 -bd 1 -relief sunken
  19.     pack .t.sep$sepId -side top -padx 2m -pady 2m -fill x
  20.     incr sepId
  21. }
  22. # Create buttons that control configuration options.
  23. frame .t.control
  24. pack .t.control -side top -fill x -pady 3m
  25. frame .t.control.left
  26. frame .t.control.right
  27. pack .t.control.left .t.control.right -side left -expand 1 -fill x
  28. label .t.anchorLabel -text "Anchor:"
  29. frame .t.control.left.f -width 6c -height 3c
  30. pack .t.anchorLabel .t.control.left.f -in .t.control.left -side top
  31. foreach anchor {nw n ne w center e sw s se} {
  32.     button .t.anchor-$anchor -text $anchor -command "config -anchor $anchor"
  33. }
  34. place .t.anchor-nw -in .t.control.left.f -relx 0 -relwidth 0.333 
  35. -rely 0 -relheight 0.333
  36. place .t.anchor-n -in .t.control.left.f -relx 0.333 -relwidth 0.333 
  37. -rely 0 -relheight 0.333
  38. place .t.anchor-ne -in .t.control.left.f -relx 0.666 -relwidth 0.333 
  39. -rely 0 -relheight 0.333
  40. place .t.anchor-w -in .t.control.left.f -relx 0 -relwidth 0.333 
  41. -rely 0.333 -relheight 0.333
  42. place .t.anchor-center -in .t.control.left.f -relx 0.333 -relwidth 0.333 
  43. -rely 0.333 -relheight 0.333
  44. place .t.anchor-e -in .t.control.left.f -relx 0.666 -relwidth 0.333 
  45. -rely 0.333 -relheight 0.333
  46. place .t.anchor-sw -in .t.control.left.f -relx 0 -relwidth 0.333 
  47. -rely 0.666 -relheight 0.333
  48. place .t.anchor-s -in .t.control.left.f -relx 0.333 -relwidth 0.333 
  49. -rely 0.666 -relheight 0.333
  50. place .t.anchor-se -in .t.control.left.f -relx 0.666 -relwidth 0.333 
  51. -rely 0.666 -relheight 0.333
  52. set justify center
  53. radiobutton .t.justify-left -text "Justify Left" -relief flat 
  54. -command "config -justify left" -variable justify 
  55. -value left
  56. radiobutton .t.justify-center -text "Justify Center" -relief flat 
  57. -command "config -justify center" -variable justify 
  58. -value center
  59. radiobutton .t.justify-right -text "Justify Right" -relief flat 
  60. -command "config -justify right" -variable justify 
  61. -value right
  62. pack .t.justify-left .t.justify-center .t.justify-right 
  63. -in .t.control.right -anchor w
  64. sep
  65. frame .t.f1
  66. pack .t.f1 -side top -expand 1 -fill both
  67. sep
  68. frame .t.f2
  69. pack .t.f2 -side top -expand 1 -fill both
  70. sep
  71. frame .t.f3
  72. pack .t.f3 -side top -expand 1 -fill both
  73. sep
  74. frame .t.f4
  75. pack .t.f4 -side top -expand 1 -fill both
  76. sep
  77. label .t.l1 -text Label -bd 2 -relief sunken
  78. label .t.l2 -text "Explicitnnewlinesnnin the text" -bd 2 -relief sunken
  79. label .t.l3 -text "This text is quite long, so it must be wrapped automatically by Tk" -wraplength 2i -bd 2 -relief sunken -underline 50
  80. pack .t.l1 .t.l2 .t.l3 -in .t.f1 -side left -padx 5m -pady 3m 
  81. -expand y -fill both
  82. button .t.b1 -text Button
  83. button .t.b2 -text "Explicitnnewlinesnnin the text"
  84. button .t.b3 -text "This text is quite long, so it must be wrapped automatically by Tk" -wraplength 2i -underline 50
  85. pack .t.b1 .t.b2 .t.b3 -in .t.f2 -side left -padx 5m -pady 3m 
  86. -expand y -fill both
  87. checkbutton .t.c1 -text Checkbutton -variable a
  88. checkbutton .t.c2 -text "Explicitnnewlinesnnin the text" -variable b
  89. checkbutton .t.c3 -text "This text is quite long, so it must be wrapped automatically by Tk" -wraplength 2i -variable c -underline 50
  90. pack .t.c1 .t.c2 .t.c3 -in .t.f3 -side left -padx 5m -pady 3m 
  91. -expand y -fill both
  92. radiobutton .t.r1 -text Radiobutton -value a
  93. radiobutton .t.r2 -text "Explicitnnewlinesnnin the text" -value b
  94. radiobutton .t.r3 -text "This text is quite long, so it must be wrapped automatically by Tk" -wraplength 2i -value c -underline 50
  95. pack .t.r1 .t.r2 .t.r3 -in .t.f4 -side left -padx 5m -pady 3m 
  96. -expand y -fill both
  97. proc config {option value} {
  98.     foreach w {.t.l1 .t.l2 .t.l3 .t.b1 .t.b2 .t.b3 .t.c1 .t.c2 .t.c3
  99.     .t.r1 .t.r2 .t.r3} {
  100. $w configure $option $value
  101.     }
  102. }