Tcl/Tk Programming




label .label1  -text "This is a text label" 

pack  .label1 


 

 

label .label2 -text "More text" -relief sunken 

pack  .label2 


 

label .label3 -text "Coloured text" -background red -foreground blue 

pack  .label3 


 

 

 

set text "Hello there" 

label .label4 -text $text 

pack  .label4 


 

 

#This example shows different forms for the label widget 

     label .lab1 -text "This is text" 

     label .lab2 -text "This is coloured text" -foreground red   

                 -background blue 

     label .lab3 -text "Sunken text"  -relief sunken 

     label .lab4 -text "Grooved text" -relief groove 

     label .lab5 -text "Flat text"    -relief flat 

     label .lab6 -text "Ridged text"  -relief ridge 

     label .lab7 -text "Raised text"  -relief raised 

     label .lab8 -text "Times font"   

                  -font *-times-medium-r-normal--*-100-* 

     pack  .lab1 .lab2 .lab3 .lab4 .lab5 .lab6 .lab7 .lab8   

                    -padx 2m -pady 1m -fill x 


 

 

 

message .msg -text "When the lights turn  

     green you may proceed with caution - when the  

     lights are red you must stop - when  

     the lights turn  to red you should stop, unless  

     it is dangerous to do so, and would endanger  

     following traffic - when the lights are amber, you  

     should prepare to stop, and when the  

     red and amber lights are on, you may prepare to  

     move off." 

 

pack .msg 


 

 

 

entry .entrybox1  -textvariable variable 

pack  .entrybox1 


 

 

 

entry .entrybox2 -relief ridge -textvariable variable 

pack  .entrybox2 

 

puts $variable 


 

 

 

 

#Set up a listbox to show rainbow colours 

listbox .listbox1  

pack .listbox1 

 

#The following is an example of a widget specific command -this is 

#the insert operation for listboxes, which inserts a list of 

#items starting at line 0 

.listbox1 insert 0 red orange yellow green blue indigo violet 


 

 

 

 

 

text .text1 -width 45 -height 5 -relief sunken 

pack .text1 

 

#The following is another example of a widget specific command - 

#this is the insert operation for text widgets, which  

#inserts a list of characters starting at line 1, character 0. 

 

.text1 insert 1.0 "     Twas brillig and the slithy toves 

   did gyre and gimble in the wabe  

   All mimsy were the borogoves 

   and the mome raths outgrabe" 


 

 

 

 

 

#Make a scale, oriented vertically, going down from 50 to 0. 

#Tick marks are places alongside the scale every 10 units. 

scale .scale1 -width 10 -orient vertical -length 280  

            -from 50 -to 0  -command "set var1"  

            -tickinterval 10 -relief raised 

 

label .lab1 -width 10 -textvariable var1 -relief sunken 

pack .scale1 .lab1 -padx 1m -pady 2m  -fill x 

 

#Now set the value of scale to 25 using a widget command 

.scale1 set 25 

 

 

 

button .b -text "Press Me" -command exit 

pack .b 

.b configure -background Red  


 

 

 

 

frame .frame1 -width 100 -height 100 

     bind .frame1  {puts "frame1: Button 1 pressed"} 

     bind .frame1  {puts "frame1: Button 2 pressed"} 

     bind .frame1  {puts "frame1: Button 3 pressed"} 

     bind .frame1  {puts "frame1: Button 1 released"} 

     bind .frame1    

                     {puts "frame1: Double click Button 1"} 

     bind .frame1  {puts "frame1: pointer at %x,%y"} 

     pack .frame1 


 

 

 

 

#Set up a listbox to show rainbow colours 

#and demonstrate selection 

listbox .listbox2 -exportselection 1 

pack .listbox2 

 

#The following is an example of a widget specific command -this is 

#the insert operation for listboxes, which inserts a list of 

#items starting at line 0 

.listbox2 insert 0 red orange yellow green blue indigo violet 

 

#There are no pre-declared bindings for the listbox 

#Now bind a button release event on button 1 to the widget 

#This will NOT interfere with the selection process! 

bind .listbox2  {showindices} 

 

#Now define procedure to show selected indices 

proc showindices {} { 

       puts [.listbox2 curselection] 

} 


 

 

 

button .button1 -text "Button1" -command "cmd1"  

     button .button2 -text "Button2" -command "cmd2"  

     button .button3 -text "Button3" -command "cmd3"  

pack .button1 .button2 .button3 

 

 

button .button1 -text "Button1" -command "cmd1"  

     button .button2 -text "Button2" -command "cmd2"  

     button .button3 -text "Button3" -command "cmd3"  

pack .button1 .button2 .button3 -side left 


 

 

 

 

label .lab1 -text "This is label 1" 

      label .lab2 -text "This is label 2" 

      label .lab3 -text "This is label 3" 

pack  .lab1 .lab2 .lab3 


 

 

for {set i 1} {$i<=3} {incr i 1}  { 

         label .lab$i -text "This is label $i" 

         pack  .lab$i 

} 


 

 

 

for {set i 1} {$i <=31} {incr i 1} { 

         button .button$i -width 20 -text "$i" -command "daydetails $i" 

         pack   .button$i 

} 


 

 

 

 

 

proc makecalendar {daysinmonth} { 

       for {set i 1} {$i <= $daysinmonth} {incr i 1}  { 

         button .button$i -width 16 -text "$i" -command "daydetails $i" 

         pack   .button$i 

         } 

      } 

 

makecalendar 31 


 

 

 

 

 

 

#Define 2 frames - 1 to contain the columns, and 1 to contain the  

     #Save and Quit button. 

 

     frame .fr1 

     frame .fr2 

 

     #Define two frames for the columns 

     frame  .fr1.c1 

     frame  .fr1.c2 

 

     #define labels 

     label .fr1.c1.lab1  -text "Surname" 

     label .fr1.c1.lab2  -text "First Names" 

     label .fr1.c1.lab3  -text "Address" 

     label .fr1.c1.lab4  -text "Telephone Number" 

     label .fr1.c1.lab5  -text "Sex" 

     label .fr1.c1.lab6  -text "Age" 

 

     #Now define the other widgets for the data 

     entry .fr1.c2.surname1   -width 30 -relief sunken -textvariable surname 

     entry .fr1.c2.firstname1 -width 30 -relief sunken   

                      -textvariable firstnames 

     entry  .fr1.c2.address1   -width 30 -relief sunken   

                      -textvariable address 

     entry .fr1.c2.telephone -width 20 -relief sunken -textvariable telno 

     entry .fr1.c2.age1      -width 20 -relief sunken -textvariable age 

     entry .fr1.c2.sex1      -width 20 -relief sunken -textvariable sex 

 

     #We shall defer consideration of the use of radio buttons for 

     #the next section, so we will simply allocate an entry widget for  

     #Sex for the moment. 

 

     #Now define the buttons for saving and quitting 

     button .fr2.button1 -text "Save" -command {savecommand} 

     button .fr2.button2 -text "Quit" -command {exit} 

 

     #Note: the command for save could be done by system 

     #dependent commands, or by TCL commands. 

     #For portability it is best to package them into a TCL procedure 

 

     #Now pack all the widgets together - first within each frame 

     #Column 1 widgets 

     pack .fr1.c1.lab1 .fr1.c1.lab2 .fr1.c1.lab3 .fr1.c1.lab4   

          .fr1.c1.lab5 .fr1.c1.lab6 -pady 1m 

     #Column 2 widgets 

     pack .fr1.c2.surname1 .fr1.c2.firstname1 .fr1.c2.address1   

          .fr1.c2.telephone .fr1.c2.sex1 .fr1.c2.age1   

          -padx 3m -pady 1m -fill x 

     #Now pack frames side by side      

     pack  .fr1.c1 .fr1.c2 -side left 

 

     #now develop the procedure for saving the data file 

 

     proc savecommand {} { 

         #external variables have to be declared as "global" 

       global surname firstnames address telno sex age 

       set file [open /tmp/outfile w] 

       puts $file $surname 

       puts $file $firstnames 

       puts $file $address 

       puts $file $telno 

       puts $file $sex 

       puts $file $age 

       close $file 

       } 

 

    #Note: In Unix this could have been written as 

    #        proc savecommand {} { 

    #           global surname firstnames address telno sex age 

    #           exec echo $surname    > /tmp/outfile 

    #           exec echo $firstnames >> /tmp/outfile 

    #           exec echo $address    >> /tmp/outfile 

    #           exec echo $telno      >> /tmp/outfile 

    #           exec echo $sex        >> /tmp/outfile 

    #           exec echo $age        >> /tmp/outfile 

    #       } 

 

    # And finally pack the Save and Quit buttons at the bottom 

    pack .fr2.button1 .fr2.button2 -padx 2m -pady 1m -fill x 

    pack .fr1  

    pack .fr2 -padx 2m -pady 1m  -fill x 

 


 

 

 

 

 

 

radiobutton .male -width 10 -text "Male"  -variable sex -value "Male" 

radiobutton .female -width 10 -text "Female" -variable sex -value "Female" 


 

 

 

 

 

 

#set gender "Female"  - initialisation - if needed 

checkbutton .sex1 -width 15 -textvariable "gender" -variable sex   

   -onvalue Male -offvalue Female   

   -command {set gender $sex} 


 

 

 

 

 

 

 

button .clear -text Clear -command {ClearData} 

 

 

proc ClearData {} { 

       set firstname1 "" 

       set surname1 "" 

       set address1 "" 

       set telephone "" 

       set age1 "" 

       set sex Male 

         #or female if you prefer! 

       } 

 

button .load -text Load -command {LoadData} 

 

 

proc LoadData {} { 

        set infile [open inputfile r] 

        gets $infile $firstname1 

        gets $infile $surname1 

        gets $infile $address1 

        gets $infile $telephone 

        gets $infile $age1 

        gets $infile $sex 

        } 


 

 

 

 

 

 

 

 

.listbox1 yview 3 

   .listbox1 yview 10 

   .listbox1 yview 20 

   .listbox1 yview 1 

   .listbox1 yview end 


 

 

 

 

 

   #Set up a listbox to show European cities 

   listbox .listbox2 

   #The following is an example of a widget specific command -this is 

   #the insert operation for listboxes, which inserts a list of 

   #items starting at line 0 

   .listbox2 insert 0 Aberdeen Alicante Athens Basel Berne   

        Bilbao Cannes Edinburgh Glasgow Geneva   

        Lisbon London Madrid   

        Munich Paris Rome   

        Rouen Venice Zurich 

   #The only way this can be scrolled at present is by 

   #using Button 2 to grab the text. Now we'll try to attach 

   #some buttons to control it. 

   #Set up a new frame with two buttons 

   frame .fr -relief raised 

   button .fr.button1 -text "UP" -command {.listbox2 yview 1} 

   button .fr.button2 -text "DOWN" -command  {.listbox2 yview 10} 

   #The buttons are associated with listbox commands to move the 

   #data which is in view. 

   #Now pack everything together 

   pack .listbox2 .fr -side left -padx 1m -fill x 

   pack .fr.button1 .fr.button2 -padx 1m -pady 2m -fill x -fill y 


 

 

 

 

 

#First make a menu button 

    menubutton .menu1 -text "Unix commands" -menu .menu1.m   

        -underline 0 

 

    #Now make the menu, and add the lines one at a time 

    menu .menu1.m 

    .menu1.m add command -label "List Files" -command {ls} 

    .menu1.m add command -label "Get date" -command {date} 

    .menu1.m add command -label "Start calendar" -command {xcalendar} 

 

    pack .menu1