home *** CD-ROM | disk | FTP | other *** search
/ PCNET 2006 September - Disc 1 / PCNET_CD_2006_09.iso / linux / puppy-barebones-2.01r2.iso / pup_201.sfs / usr / lib / combobox-2.3 / example.tcl < prev    next >
Encoding:
Text File  |  2003-09-30  |  5.3 KB  |  164 lines
  1. # A simple font display utility.
  2. # 
  3. # This program uses two variations of the combobox. One, for the font
  4. # family, is non-editable (ie: the user can only pick from the list). 
  5. # The other, for font size, is editable. The user can pick from the list 
  6. # or enter their own size
  7.  
  8. # substitute your favorite method here...
  9. source combobox.tcl
  10. package require combobox 2.3
  11. catch {namespace import combobox::*}
  12.  
  13. proc main {} {
  14.     # this lets us be reentrant...
  15.     destroy .fontpicker .msg
  16.  
  17.     # default values
  18.     set ::size       12
  19.     set ::family     [lindex [lsort [font families]] 0]
  20.     set ::slant      roman
  21.     set ::weight     normal
  22.     set ::overstrike 0
  23.     set ::underline  0
  24.  
  25.     wm title . "Combobox Example"
  26.  
  27.     # the main two areas: a frame to hold the font picker widgets
  28.     # and a label to display a sample from the font
  29.     set fp [frame .fontpicker]
  30.     set msg [label .msg -borderwidth 2 -relief groove -width 30 -height 4]
  31.  
  32.     pack $fp -side top -fill x
  33.     pack $msg -side top -fill both -expand y -pady 2
  34.  
  35.     $msg configure -text [join [list \
  36.         "ABCDEFGHIJKLMNOPQRSTUVWXYZ" \
  37.         "abcdefghijklmnopqrstuvwxyz" \
  38.         "0123456789~`!@#$%^&*()_-+=" \
  39.         "{}[]:;\"'<>,.?/"] "\n"]
  40.  
  41.     # this will set the font of the message according to our defaults
  42.     changeFont $msg
  43.  
  44.     # font family...
  45.     label $fp.famLabel -text "Font Family:"
  46.     combobox $fp.famCombo \
  47.         -borderwidth 1 \
  48.         -textvariable family \
  49.         -editable false \
  50.         -highlightthickness 1 \
  51.         -command [list changeFont $msg]
  52.  
  53.  
  54.     grid $fp.famLabel -row 0 -column 0 -sticky e
  55.     grid $fp.famCombo -row 0 -column 1 -sticky ew
  56.     grid columnconfigure $fp 1 -weight 1
  57.  
  58.     # we'll do these one at a time so we can find the widest one and
  59.     # set the width of the combobox accordingly (hmmm... wonder if this
  60.     # sort of thing should be done by the combobox itself...?)
  61.     set widest 0
  62.     foreach family [lsort [font families]] {
  63.     if {[set length [string length $family]] > $widest} {
  64.         set widest $length
  65.     }
  66.     $fp.famCombo list insert end $family
  67.     }
  68.     $fp.famCombo configure -width $widest
  69.  
  70.     # the font size. We know we are puting a fairly small, finite
  71.     # number of items in this combobox, so we'll set its maxheight
  72.     # to zero so it will grow to fit the number of items
  73.     label $fp.sizeLabel -text "Font Size:"
  74.     combobox $fp.sizeCombo \
  75.         -borderwidth 1 \
  76.         -highlightthickness 1 \
  77.         -maxheight 0 \
  78.         -width 3 \
  79.         -textvariable size \
  80.         -editable true \
  81.         -command [list changeFont $msg]
  82.  
  83.     grid $fp.sizeLabel -row 0 -column 2 -sticky e -padx 2
  84.     grid $fp.sizeCombo -row 0 -column 3 -sticky new 
  85.     grid columnconfigure $fp 3 -weight 1
  86.     eval $fp.sizeCombo list insert end [list 8 9 10 12 14 16 18 20 24 28 32 36]
  87.  
  88.     # a dummy frame to give a little spacing...
  89.     frame $fp.dummy -width 5
  90.     grid $fp.dummy -row 0 -column 4 
  91.  
  92.     # bold
  93.     set bold "bold"
  94.     checkbutton $fp.bold -variable weight -indicatoron false \
  95.         -onvalue bold -offvalue normal \
  96.         -text "B" -width 2 -height 1 \
  97.         -font {-weight bold -family Times -size 12} \
  98.         -highlightthickness 1 -padx 0 -pady 0 -borderwidth 1 \
  99.         -command [list changeFont $msg]
  100.     grid $fp.bold -row 0 -column 5 -sticky nsew
  101.  
  102.     # underline
  103.     checkbutton $fp.underline -variable underline -indicatoron false \
  104.         -onvalue 1 -offvalue 0 \
  105.         -text "U" -width 2 -height 1 \
  106.         -font {-underline 1 -family Times -size 12} \
  107.         -highlightthickness 1 -padx 0 -pady 0 -borderwidth 1 \
  108.         -command [list changeFont $msg]
  109.     grid $fp.underline -row 0 -column 6 -sticky nsew
  110.  
  111.     # italic
  112.     checkbutton $fp.italic -variable slant -indicatoron false \
  113.         -onvalue italic -offvalue roman \
  114.         -text "I" -width 2 -height 1 \
  115.         -font {-slant italic -family Times -size 12} \
  116.         -highlightthickness 1 -padx 0 -pady 0 -borderwidth 1 \
  117.         -command [list changeFont $msg]
  118.     grid $fp.italic -row 0 -column 7 -sticky nsew
  119.  
  120.     # overstrike
  121.     checkbutton $fp.overstrike -variable overstrike -indicatoron false \
  122.         -onvalue 1 -offvalue 0 \
  123.         -text "O" -width 2 -height 1 \
  124.         -font {-overstrike 1 -family Times -size 12} \
  125.         -highlightthickness 1 -padx 0 -pady 0 -borderwidth 1 \
  126.         -command [list changeFont $msg]
  127.     grid $fp.overstrike -row 0 -column 8 -sticky nsew
  128.  
  129.     # this gives us relatively square buttons that fill the frame
  130.     # in the Y direction
  131.     bind $fp <Configure> {
  132.     grid columnconfigure %W 5 -minsize %h
  133.     grid columnconfigure %W 6 -minsize %h
  134.     grid columnconfigure %W 7 -minsize %h
  135.     grid columnconfigure %W 8 -minsize %h
  136.     }
  137.     # put focus on the first widget
  138.     catch {focus $fp.famCombo}
  139.  
  140.     return ""
  141. }
  142.  
  143. # this proc changes the font. It is called by various methods, so
  144. # the only parameter we are guaranteed is the first one since
  145. # we supply it ourselves...
  146. proc ::changeFont {w args} {
  147.     foreach foo [list family size weight underline slant overstrike] {
  148.     if {[set ::$foo] == ""} {
  149.         return
  150.     }
  151.     }
  152.     set ::fontspec [list \
  153.         -family     $::family \
  154.         -size       $::size \
  155.         -weight     $::weight \
  156.         -underline  $::underline \
  157.         -slant      $::slant \
  158.         -overstrike $::overstrike \
  159.     ]
  160.     $w configure -font $::fontspec
  161. }
  162.  
  163. main
  164.