home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tk8.0 / tests / butGeom2.tcl < prev    next >
Encoding:
Text File  |  1997-08-15  |  4.2 KB  |  114 lines  |  [TEXT/ALFA]
  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. # SCCS: @(#) butGeom2.tcl 1.3 97/06/13 17:00:32
  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 color options for various flavors of buttons.  Select display options below, and they will be applied to the appropiate button 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 "Color:"
  35. frame .t.control.left.f -width 6c -height 3c
  36. pack .t.anchorLabel .t.control.left.f -in .t.control.left -side top -anchor w
  37. foreach opt {activebackground activeforeground background disabledforeground foreground highlightbackground highlightcolor } {
  38.     #button .t.color-$opt -text $opt -command "config -$opt \[tk_chooseColor]"
  39.     menubutton .t.color-$opt -text $opt -menu .t.color-$opt.m -indicatoron 1 \
  40.         -relief raised -bd 2 
  41.     menu .t.color-$opt.m -tearoff 0
  42.     .t.color-$opt.m add command -label Red -command "config -$opt red"
  43.     .t.color-$opt.m add command -label Green -command "config -$opt green"
  44.     .t.color-$opt.m add command -label Blue -command "config -$opt blue"
  45.     .t.color-$opt.m add command -label Other... \
  46.           -command "config -$opt \[tk_chooseColor]"
  47.     pack .t.color-$opt -in .t.control.left.f -fill x
  48. }
  49.  
  50. set default disabled
  51. label .t.default -text Default:
  52. radiobutton .t.default-normal -text "Default normal" -relief flat \
  53.     -command "config-but -default normal" -variable default \
  54.     -value normal
  55. radiobutton .t.default-active -text "Default active" -relief flat \
  56.     -command "config-but -default active" -variable default \
  57.     -value active
  58. radiobutton .t.default-disabled -text "Default disabled" -relief flat \
  59.     -command "config-but -default disabled" -variable default \
  60.     -value disabled
  61. pack .t.default .t.default-normal .t.default-active .t.default-disabled \
  62.     -in .t.control.right -anchor w
  63.  
  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.  
  78. label .t.l1 -text Label -bd 2 -relief sunken
  79. label .t.l2 -text "Explicit\nnewlines\n\nin the text" -bd 2 -relief sunken
  80. 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
  81. pack .t.l1 .t.l2 .t.l3 -in .t.f1 -side left -padx 5m -pady 3m \
  82.     -expand y -fill both
  83.  
  84. button .t.b1 -text Button
  85. button .t.b2 -text "Explicit\nnewlines\n\nin the text"
  86. button .t.b3 -text "This text is quite long, so it must be wrapped automatically by Tk" -wraplength 2i -underline 50
  87. pack .t.b1 .t.b2 .t.b3 -in .t.f2 -side left -padx 5m -pady 3m \
  88.     -expand y -fill both
  89.  
  90. checkbutton .t.c1 -text Checkbutton -variable a
  91. checkbutton .t.c2 -text "Explicit\nnewlines\n\nin the text" -variable b
  92. checkbutton .t.c3 -text "This text is quite long, so it must be wrapped automatically by Tk" -wraplength 2i -variable c -underline 50
  93. pack .t.c1 .t.c2 .t.c3 -in .t.f3 -side left -padx 5m -pady 3m \
  94.     -expand y -fill both
  95.  
  96. radiobutton .t.r1 -text Radiobutton -value a
  97. radiobutton .t.r2 -text "Explicit\nnewlines\n\nin the text" -value b
  98. radiobutton .t.r3 -text "This text is quite long, so it must be wrapped automatically by Tk" -wraplength 2i -value c -underline 50
  99. pack .t.r1 .t.r2 .t.r3 -in .t.f4 -side left -padx 5m -pady 3m \
  100.     -expand y -fill both
  101.  
  102. proc config {option value} {
  103.     foreach w {.t.l1 .t.l2 .t.l3 .t.b1 .t.b2 .t.b3 .t.c1 .t.c2 .t.c3
  104.         .t.r1 .t.r2 .t.r3} {
  105.     catch {$w configure $option $value}
  106.     }
  107. }
  108.  
  109. proc config-but {option value} {
  110.     foreach w {.t.b1 .t.b2 .t.b3} {
  111.     $w configure $option $value
  112.     }
  113. }
  114.