tk/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 # RCS: @(#) $Id$
   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 center
  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
 117
 118
 119
 120
 121
 122
 123
 124
 125
 126
 127
 128