util/src/TclTk/tk8.6.12/tests/butGeom.tcl

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