diff options
author | rjohnson <rjohnson@noemail.net> | 1998-04-01 09:51:45 (GMT) |
---|---|---|
committer | rjohnson <rjohnson@noemail.net> | 1998-04-01 09:51:45 (GMT) |
commit | 9c5b7f2b7e472536ed2e7c915ead05e2aa264182 (patch) | |
tree | 8fb30cb152c4dc191be47fa043d2e6f5ea38c7ba /tests/butGeom2.tcl | |
parent | 1d0efcbe267f2c0eb73869862522fb20fb2d63ca (diff) | |
download | tk-9c5b7f2b7e472536ed2e7c915ead05e2aa264182.zip tk-9c5b7f2b7e472536ed2e7c915ead05e2aa264182.tar.gz tk-9c5b7f2b7e472536ed2e7c915ead05e2aa264182.tar.bz2 |
Initial revision
FossilOrigin-Name: 2bf55ca9aa942b581137b9f474da5ad9c1480de4
Diffstat (limited to 'tests/butGeom2.tcl')
-rw-r--r-- | tests/butGeom2.tcl | 113 |
1 files changed, 113 insertions, 0 deletions
diff --git a/tests/butGeom2.tcl b/tests/butGeom2.tcl new file mode 100644 index 0000000..f1293a0 --- /dev/null +++ b/tests/butGeom2.tcl @@ -0,0 +1,113 @@ +# This file creates a visual test for button layout. It is part of +# the Tk visual test suite, which is invoked via the "visual" script. +# +# SCCS: @(#) butGeom2.tcl 1.3 97/06/13 17:00:32 + +catch {destroy .t} +toplevel .t +wm title .t "Visual Tests for Button Geometry" +wm iconname .t "Button Geometry" +wm geom .t +0+0 +wm minsize .t 1 1 + +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 +pack .t.l -side top -fill both + +button .t.quit -text Quit -command {destroy .t} +pack .t.quit -side bottom -pady 2m + +set sepId 1 +proc sep {} { + global sepId + frame .t.sep$sepId -height 2 -bd 1 -relief sunken + pack .t.sep$sepId -side top -padx 2m -pady 2m -fill x + incr sepId +} + +# Create buttons that control configuration options. + +frame .t.control +pack .t.control -side top -fill x -pady 3m +frame .t.control.left +frame .t.control.right +pack .t.control.left .t.control.right -side left -expand 1 -fill x +label .t.anchorLabel -text "Color:" +frame .t.control.left.f -width 6c -height 3c +pack .t.anchorLabel .t.control.left.f -in .t.control.left -side top -anchor w +foreach opt {activebackground activeforeground background disabledforeground foreground highlightbackground highlightcolor } { + #button .t.color-$opt -text $opt -command "config -$opt \[tk_chooseColor]" + menubutton .t.color-$opt -text $opt -menu .t.color-$opt.m -indicatoron 1 \ + -relief raised -bd 2 + menu .t.color-$opt.m -tearoff 0 + .t.color-$opt.m add command -label Red -command "config -$opt red" + .t.color-$opt.m add command -label Green -command "config -$opt green" + .t.color-$opt.m add command -label Blue -command "config -$opt blue" + .t.color-$opt.m add command -label Other... \ + -command "config -$opt \[tk_chooseColor]" + pack .t.color-$opt -in .t.control.left.f -fill x +} + +set default disabled +label .t.default -text Default: +radiobutton .t.default-normal -text "Default normal" -relief flat \ + -command "config-but -default normal" -variable default \ + -value normal +radiobutton .t.default-active -text "Default active" -relief flat \ + -command "config-but -default active" -variable default \ + -value active +radiobutton .t.default-disabled -text "Default disabled" -relief flat \ + -command "config-but -default disabled" -variable default \ + -value disabled +pack .t.default .t.default-normal .t.default-active .t.default-disabled \ + -in .t.control.right -anchor w + +sep +frame .t.f1 +pack .t.f1 -side top -expand 1 -fill both +sep +frame .t.f2 +pack .t.f2 -side top -expand 1 -fill both +sep +frame .t.f3 +pack .t.f3 -side top -expand 1 -fill both +sep +frame .t.f4 +pack .t.f4 -side top -expand 1 -fill both +sep + +label .t.l1 -text Label -bd 2 -relief sunken +label .t.l2 -text "Explicit\nnewlines\n\nin the text" -bd 2 -relief sunken +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 +pack .t.l1 .t.l2 .t.l3 -in .t.f1 -side left -padx 5m -pady 3m \ + -expand y -fill both + +button .t.b1 -text Button +button .t.b2 -text "Explicit\nnewlines\n\nin the text" +button .t.b3 -text "This text is quite long, so it must be wrapped automatically by Tk" -wraplength 2i -underline 50 +pack .t.b1 .t.b2 .t.b3 -in .t.f2 -side left -padx 5m -pady 3m \ + -expand y -fill both + +checkbutton .t.c1 -text Checkbutton -variable a +checkbutton .t.c2 -text "Explicit\nnewlines\n\nin the text" -variable b +checkbutton .t.c3 -text "This text is quite long, so it must be wrapped automatically by Tk" -wraplength 2i -variable c -underline 50 +pack .t.c1 .t.c2 .t.c3 -in .t.f3 -side left -padx 5m -pady 3m \ + -expand y -fill both + +radiobutton .t.r1 -text Radiobutton -value a +radiobutton .t.r2 -text "Explicit\nnewlines\n\nin the text" -value b +radiobutton .t.r3 -text "This text is quite long, so it must be wrapped automatically by Tk" -wraplength 2i -value c -underline 50 +pack .t.r1 .t.r2 .t.r3 -in .t.f4 -side left -padx 5m -pady 3m \ + -expand y -fill both + +proc config {option value} { + foreach w {.t.l1 .t.l2 .t.l3 .t.b1 .t.b2 .t.b3 .t.c1 .t.c2 .t.c3 + .t.r1 .t.r2 .t.r3} { + catch {$w configure $option $value} + } +} + +proc config-but {option value} { + foreach w {.t.b1 .t.b2 .t.b3} { + $w configure $option $value + } +} |