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: butGeom2.tcl,v 1.3 1999/04/16 01:51:34 stanton Exp $ 5 6catch {destroy .t} 7toplevel .t 8wm title .t "Visual Tests for Button Geometry" 9wm iconname .t "Button Geometry" 10wm geom .t +0+0 11wm minsize .t 1 1 12 13label .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 14pack .t.l -side top -fill both 15 16button .t.quit -text Quit -command {destroy .t} 17pack .t.quit -side bottom -pady 2m 18 19set sepId 1 20proc 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 29frame .t.control 30pack .t.control -side top -fill x -pady 3m 31frame .t.control.left 32frame .t.control.right 33pack .t.control.left .t.control.right -side left -expand 1 -fill x 34label .t.anchorLabel -text "Color:" 35frame .t.control.left.f -width 6c -height 3c 36pack .t.anchorLabel .t.control.left.f -in .t.control.left -side top -anchor w 37foreach 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 50set default disabled 51label .t.default -text Default: 52radiobutton .t.default-normal -text "Default normal" -relief flat \ 53 -command "config-but -default normal" -variable default \ 54 -value normal 55radiobutton .t.default-active -text "Default active" -relief flat \ 56 -command "config-but -default active" -variable default \ 57 -value active 58radiobutton .t.default-disabled -text "Default disabled" -relief flat \ 59 -command "config-but -default disabled" -variable default \ 60 -value disabled 61pack .t.default .t.default-normal .t.default-active .t.default-disabled \ 62 -in .t.control.right -anchor w 63 64sep 65frame .t.f1 66pack .t.f1 -side top -expand 1 -fill both 67sep 68frame .t.f2 69pack .t.f2 -side top -expand 1 -fill both 70sep 71frame .t.f3 72pack .t.f3 -side top -expand 1 -fill both 73sep 74frame .t.f4 75pack .t.f4 -side top -expand 1 -fill both 76sep 77 78label .t.l1 -text Label -bd 2 -relief sunken 79label .t.l2 -text "Explicit\nnewlines\n\nin the text" -bd 2 -relief sunken 80label .t.l3 -text "This text is quite long, so it must be wrapped automatically by Tk" -wraplength 2i -bd 2 -relief sunken -underline 50 81pack .t.l1 .t.l2 .t.l3 -in .t.f1 -side left -padx 5m -pady 3m \ 82 -expand y -fill both 83 84button .t.b1 -text Button 85button .t.b2 -text "Explicit\nnewlines\n\nin the text" 86button .t.b3 -text "This text is quite long, so it must be wrapped automatically by Tk" -wraplength 2i -underline 50 87pack .t.b1 .t.b2 .t.b3 -in .t.f2 -side left -padx 5m -pady 3m \ 88 -expand y -fill both 89 90checkbutton .t.c1 -text Checkbutton -variable a 91checkbutton .t.c2 -text "Explicit\nnewlines\n\nin the text" -variable b 92checkbutton .t.c3 -text "This text is quite long, so it must be wrapped automatically by Tk" -wraplength 2i -variable c -underline 50 93pack .t.c1 .t.c2 .t.c3 -in .t.f3 -side left -padx 5m -pady 3m \ 94 -expand y -fill both 95 96radiobutton .t.r1 -text Radiobutton -value a 97radiobutton .t.r2 -text "Explicit\nnewlines\n\nin the text" -value b 98radiobutton .t.r3 -text "This text is quite long, so it must be wrapped automatically by Tk" -wraplength 2i -value c -underline 50 99pack .t.r1 .t.r2 .t.r3 -in .t.f4 -side left -padx 5m -pady 3m \ 100 -expand y -fill both 101 102proc 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 109proc config-but {option value} { 110 foreach w {.t.b1 .t.b2 .t.b3} { 111 $w configure $option $value 112 } 113} 114 115 116 117 118 119 120 121 122 123 124 125 126 127