home *** CD-ROM | disk | FTP | other *** search
/ Ultra Pack / UltraComputing Partner Applications.iso / SunLabs / tclTK / src / tk4.0 / tests / butGeom.tcl < prev    next >
Encoding:
Text File  |  1994-08-10  |  4.5 KB  |  116 lines
  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. # @(#) butGeom.tcl 1.1 94/08/10 15:49:40
  5.  
  6. catch {destroy .t}
  7. toplevel .t
  8. wm title .t "Visual Tests for Button Geometry"
  9. wm iconname .t "Button Geometry"
  10. wm geom .t +0+0
  11. wm minsize .t 1 1
  12.  
  13. 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
  14. pack .t.l -side top -fill both
  15.  
  16. button .t.quit -text Quit -command {destroy .t}
  17. pack .t.quit -side bottom -pady 2m
  18.  
  19. set sepId 1
  20. proc sep {} {
  21.     global sepId
  22.     frame .t.sep$sepId -height 2 -bd 1 -relief sunken
  23.     pack .t.sep$sepId -side top -padx 2m -pady 2m -fill x
  24.     incr sepId
  25. }
  26.  
  27. # Create buttons that control configuration options.
  28.  
  29. frame .t.control
  30. pack .t.control -side top -fill x -pady 3m
  31. frame .t.control.left
  32. frame .t.control.right
  33. pack .t.control.left .t.control.right -side left -expand 1 -fill x
  34. label .t.anchorLabel -text "Anchor:"
  35. frame .t.control.left.f -width 6c -height 3c
  36. pack .t.anchorLabel .t.control.left.f -in .t.control.left -side top
  37. foreach anchor {nw n ne w center e sw s se} {
  38.     button .t.anchor-$anchor -text $anchor -command "config -anchor $anchor"
  39. }
  40. place .t.anchor-nw -in .t.control.left.f -relx 0 -relwidth 0.333 \
  41.     -rely 0 -relheight 0.333
  42. place .t.anchor-n -in .t.control.left.f -relx 0.333 -relwidth 0.333 \
  43.     -rely 0 -relheight 0.333
  44. place .t.anchor-ne -in .t.control.left.f -relx 0.666 -relwidth 0.333 \
  45.     -rely 0 -relheight 0.333
  46. place .t.anchor-w -in .t.control.left.f -relx 0 -relwidth 0.333 \
  47.     -rely 0.333 -relheight 0.333
  48. place .t.anchor-center -in .t.control.left.f -relx 0.333 -relwidth 0.333 \
  49.     -rely 0.333 -relheight 0.333
  50. place .t.anchor-e -in .t.control.left.f -relx 0.666 -relwidth 0.333 \
  51.     -rely 0.333 -relheight 0.333
  52. place .t.anchor-sw -in .t.control.left.f -relx 0 -relwidth 0.333 \
  53.     -rely 0.666 -relheight 0.333
  54. place .t.anchor-s -in .t.control.left.f -relx 0.333 -relwidth 0.333 \
  55.     -rely 0.666 -relheight 0.333
  56. place .t.anchor-se -in .t.control.left.f -relx 0.666 -relwidth 0.333 \
  57.     -rely 0.666 -relheight 0.333
  58.  
  59. set justify left
  60. radiobutton .t.justify-left -text "Justify Left" -relief flat \
  61.     -command "config -justify left" -variable justify \
  62.     -value left
  63. radiobutton .t.justify-center -text "Justify Center" -relief flat \
  64.     -command "config -justify center" -variable justify \
  65.     -value center
  66. radiobutton .t.justify-right -text "Justify Right" -relief flat \
  67.     -command "config -justify right" -variable justify \
  68.     -value right
  69. pack .t.justify-left .t.justify-center .t.justify-right \
  70.     -in .t.control.right -anchor w
  71.  
  72. sep
  73. frame .t.f1
  74. pack .t.f1 -side top -expand 1 -fill both
  75. sep
  76. frame .t.f2
  77. pack .t.f2 -side top -expand 1 -fill both
  78. sep
  79. frame .t.f3
  80. pack .t.f3 -side top -expand 1 -fill both
  81. sep
  82. frame .t.f4
  83. pack .t.f4 -side top -expand 1 -fill both
  84. sep
  85.  
  86. label .t.l1 -text Label -bd 2 -relief sunken
  87. label .t.l2 -text "Explicit\nnewlines\n\nin the text" -bd 2 -relief sunken
  88. 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
  89. pack .t.l1 .t.l2 .t.l3 -in .t.f1 -side left -padx 5m -pady 3m \
  90.     -expand y -fill both
  91.  
  92. button .t.b1 -text Button
  93. button .t.b2 -text "Explicit\nnewlines\n\nin the text"
  94. button .t.b3 -text "This text is quite long, so it must be wrapped automatically by Tk" -wraplength 2i -underline 50
  95. pack .t.b1 .t.b2 .t.b3 -in .t.f2 -side left -padx 5m -pady 3m \
  96.     -expand y -fill both
  97.  
  98. checkbutton .t.c1 -text Checkbutton -variable a
  99. checkbutton .t.c2 -text "Explicit\nnewlines\n\nin the text" -variable b
  100. checkbutton .t.c3 -text "This text is quite long, so it must be wrapped automatically by Tk" -wraplength 2i -variable c -underline 50
  101. pack .t.c1 .t.c2 .t.c3 -in .t.f3 -side left -padx 5m -pady 3m \
  102.     -expand y -fill both
  103.  
  104. radiobutton .t.r1 -text Radiobutton -value a
  105. radiobutton .t.r2 -text "Explicit\nnewlines\n\nin the text" -value b
  106. radiobutton .t.r3 -text "This text is quite long, so it must be wrapped automatically by Tk" -wraplength 2i -value c -underline 50
  107. pack .t.r1 .t.r2 .t.r3 -in .t.f4 -side left -padx 5m -pady 3m \
  108.     -expand y -fill both
  109.  
  110. proc config {option value} {
  111.     foreach w {.t.l1 .t.l2 .t.l3 .t.b1 .t.b2 .t.b3 .t.c1 .t.c2 .t.c3
  112.         .t.r1 .t.r2 .t.r3} {
  113.     $w configure $option $value
  114.     }
  115. }
  116.