blob: 36122ea28781fe5e89910a6c174b6e46ecc5b7e7 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
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.
#
# RCS: @(#) $Id: butGeom2.tcl,v 1.2 1998/09/14 18:23:43 stanton Exp $
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
}
}
|
