Примеры виджетов

Tcl Tk


#Create three different labels
label .l1 -text "This is what the default label looks like"
label .l2 -text "This is a yellow label on a blue background" \
    -foreground Yellow \
    -background Blue
label .l3 -text "This is a label in Times 24 font" \
    -font {-family times -size 24}

# Put them in the window in row order
grid .l1 -row 0
grid .l2 -row 1
grid .l3 -row 2


#The first button calls a procedure (callback) that 
# switches the buttons name between Hello and Goodbye.
# The second button executes a command that destroys the window.

set text Hello
proc doIt {widget} {
    global text
    if {$text == "Hello"} {
        set text "Goodbye"
    } else {
        set text "Hello"
    $widget configure -text $text

button .b1 -text "Hello" \
        -command "doIt .b1"
button .b2 -text "Quit" \
    -command "destroy ."

# Put them in the window in row order
grid .b1 -row 0 -column 0
grid .b2 -row 0 -column 1

checkbuttons and radioButtons

set font helvetica

proc applyIt { } {
    global bold italics font
    if {$bold} {set weight bold} {set weight normal}
    if {$italics} {set slant italic} {set slant roman}
    .b configure -font "-family $font -weight $weight -slant $slant"

checkbutton .c1 -text Bold -variable bold   -anchor w
checkbutton .c2 -text Italics -variable italics  -anchor w

radiobutton .r1 -text Helvetica -variable font -value helvetica
radiobutton .r2 -text Courier   -variable font -value courier   

button .b -text Apply -command "applyIt"


#The "sticky" option aligns items to the left (west) side
grid .c1 -row 0 -column 1 -sticky w
grid .c2 -row 1 -column 1 -sticky w
grid .r1 -row 0 -column 0 -sticky w
grid .r2 -row 1 -column 0 -sticky w
grid .b -row 2 -column 0 -columnspan 2


# Creates an entry that you can type in. 
# focus puts the cursor in the entry, and he button clears it

label .l -text "Enter:"
entry .e -width 40 -relief sunken -bd 2 -textvariable name
focus .e
button .b -text Clear -command {set name ""}

grid .l -row 0 -column 0 -sticky e
grid .e -row 0 -column 1 -sticky w
grid .b -row 1 -column 0 -columnspan 2


# This demonstration script creates a text widget that illustrates the
# various display styles that may be set for tags. 
# Modified from the demo widget example provided in the Tcl release

text .t -yscrollcommand ".scroll set" -setgrid true \
        -width 40 -height 10 -wrap word
scrollbar .scroll -command ".t yview"
pack .scroll -side right -fill y
pack .t -expand yes -fill both

# Set up the tags 
.t tag configure bold_italics -font \
    {-family courier -size 12 -weight bold -slant italic}
.t tag configure big -font {-family helvetica -size 24 -weight bold}
.t tag configure color1 -foreground red
.t tag configure sunken -relief sunken -borderwidth 1
.t tag bind Ouch <1> {.t insert end "Ouch! "}

# Now insert text that has the property of the tags
.t insert end "Here are a few text styles.\n"
.t insert end "1. Bold italic text.\n" bold_italics
.t insert end "2. Larger Helvetica  text.\n" big
.t insert end "3. Red text.\n" color1
.t insert end "4. Sunken text.\n" sunken
button .b -text "5. An embedded Hello Button" \
    -command {.t insert end "Hello "}
.t window create end -window .b
.t insert end "\n"
.t insert end "6. Text with a binding (try clicking me)" Ouch
.t insert end "\nAnd all this is editable!"


# An example of canvases, items, and dragging things around

proc moveit {object x y} {
  .c coords $object [expr $x-25] [expr $y-25] [expr $x+25] [expr $y+25]

canvas .c -width 250 -height 100
set myoval [.c create oval 0 0 50 50 -fill orange]
set myline [.c create line 50 50 100 100 -fill blue -width 4]

.c bind $myoval <B1-Motion>  {moveit $myoval %x %y}
.c bind $myline <B1-Motion>  {moveit $myline %x %y}

grid .c -row 0 -column 0


#Create a scrollable listbox containing color names. When a color is
# double-clicked, the label on the bottom will change to show the
# selected color name and will also change the background color

proc setLabel {color} {
    .label configure -text $color -background $color

scrollbar .s -command ".l yview"
listbox .l -yscroll ".s set"

label .label -text "Nothing Selected"

bind .l <Double-B1-ButtonRelease> {setLabel [.l get active]}

grid .l -row 0 -column 0 -sticky news
grid .s -row 0 -column 1 -sticky news
grid .label -row 1 -column 0 -columnspan 2

.l insert 0 gray60 gray70 gray80 gray85 gray90 gray95 \
    snow1 snow2 snow3 snow4 seashell1 seashell2 \
    seashell3 seashell4 AntiqueWhite1 AntiqueWhite2 AntiqueWhite3 \
    DarkSlateGray1 DarkSlateGray2 DarkSlateGray3 \
    aquamarine4 DarkSeaGreen1 DarkSeaGreen2 DarkSeaGreen3 \
    PaleGreen1 PaleGreen2 PaleGreen3 PaleGreen4 SpringGreen1 \
    green3 green4 chartreuse1 chartreuse2 chartreuse3 \
    chartreuse4 OliveDrab1 OliveDrab2 OliveDrab3 OliveDrab4 \
    coral2 coral3 coral4 tomato1 tomato2 tomato3 tomato4 \
    red4 DeepPink1 DeepPink2 DeepPink3 DeepPink4 HotPink1 \
    HotPink2 HotPink3 HotPink4 pink1 pink2 pink3 pink4 \
    PaleVioletRed2 PaleVioletRed3 PaleVioletRed4 maroon1 \
    VioletRed4 magenta1 magenta2 magenta3 magenta4 orchid1 \
    orchid2 orchid3 orchid4 plum1 plum2 plum3 plum4 \
    DarkOrchid1 DarkOrchid2 DarkOrchid3 DarkOrchid4 purple1 \
    MediumPurple3 MediumPurple4 thistle1 thistle2 thistle3 \


# Use a scale to set the height of an arrow drawn on a canvas
#(Modified from the example supplied in the wish widget demo)
proc setHeight {w height} {
    incr height 21
    set y2 [expr $height - 30]
    if {$y2 <21} { 
        set y2 21 
    $w coords poly 15 20 35 20 35 $y2 45 $y2 25 $height 5 $y2 15 $y2 15 20 
    $w coords line 15 20 35 20 35 $y2 45 $y2 25 $height 5 $y2 15 $y2 15 20 
scale .scale -orient vertical -length 284 -from 0 -to 250 \
    -tickinterval 50 \
    -command "setHeight .canvas" 
canvas .canvas -width 50 -height 50 -bd 0 -highlightthickness 0 
.canvas create polygon 0 0 1 1 2 2 -fill SeaGreen3 -tags poly 
.canvas create line 0 0 1 1 2 2 0 0 -fill black -tags line 
grid .scale -row 0 -column 0 -sticky ne 
grid .canvas -row 0 -column 1 -sticky nwse 
.scale set 75


proc doIt {label} {
    set button \
        [tk_messageBox \
               -icon question \
               -type yesno \
               -title Message \
               -parent . \
               -message "Do you like me so far?"]
    $label configure -text $button

label .l -text "I'm not sure yet"
button .b -text "Do you like me?" \
        -command "doIt .l"

grid .b -row 0 -column 0
grid .l -row 0 -column 1


set types {
        {"All Source Files"     {.tcl .c .h}    }
        {"Image Files"          {.gif}          }
        {"All files"            *}

proc doIt {label} {
    global types   
    set file [tk_getOpenFile -filetypes $types -parent .]
    $label configure -text $file

label .l -text "No File"
button .b -text "Select a file?" \
        -command "doIt .l"

grid .b -row 0 -column 0
grid .l -row 0 -column 1


proc doIt {widget} {
    set current_color \
        [tk_chooseColor -title "Choose a background color" -parent .]
    $widget configure -background $current_color
label .l
button .b -text "Choose a color..." \
        -command "doIt .b" 
grid .b -row 0 -column 0