chfont : outil de sélection de fontes

 

chfont est un outil pour choisir des polices de caractères. (note : il en existe d'autres, voir wiki anglophone)

Il y a aussi celui d'ulis sur ce portail : Un sélectionneur de police très simple.

chfont est basé sur la Combobox de Bryan Oakley, c'est une adaptation de l'exemple livré avec.



Les adaptations sont les suivantes :


Le source

 # Font chooser
 #   adapted from Bryan Oakley Combobox example
 #
 # Makes a frequent use of "chf" prefix
 #   unique window :
 #       .chf
 #   font attributes :
 #       ::chf_size ::chf_family ::chf_slant ::chf_weight
 #       ::chf_overstrike ::chf_underline
 #
 # Usage :
 #   feed input variables
 #   call ::chf_call
 #   read output variables
 #
 # Input global variables
 #   ::chf_parent        parent window                   default .
 #   ::chf_title         window title                    default ""
 #   ::chf_famlabel      label for family                default ""
 #   ::chf_sizelabel     label for size                  default ""
 #   ::chf_butok         label for ok button             default "OK"
 #   ::chf_butcancel     label for cancel button         default "Cancel"
 #   ::chf_fontstr       initial font string (also used as output)
 #
 # Output global variables
 #   ::chf_changed       1 if font changed
 #   ::chf_fontstr       font string (for example {{Century Gothic} 8 bold italic}"
 #   chf_font            created font
 #
 # Particularities :
 #   - align position to parent
 #   - sets grab on window; if grab was previously set on another window
 #     restore this grab when quitting
 #   - underline and overstrike considered useless
 #

 #   substitute your favorite method here...
 package require combobox 2.2
 catch {namespace import combobox::*}

 #   restricted list of interesting families
 proc ::chf_initfamilies {} {
     if { ! [info exists ::chf_validfonts] } {
         set ::chf_validfonts {
             "Georgia" "Times New Roman" "Times" "Arial" "Helvetica"
             "Arial Black" "Impact" "Trebuchet" "Verdana"
             "Andale Mono" "Courier" "Courier New" "Comic Sans MS"
             "Book Antiqua" "Bookman Old Style" "Calisto MT" "Garamond"
             "Century Gothic" "News Gothic MT" "Tahoma" "Monotype Corsiva"
             "Pouet" "Chicago" "New York" "Palatino" "Charcoal" "Geneva"
             "LUxi Serif" "Serif" "SansSerif" "New Century Schoolbook"
             "Utopia" "LUxi Sans" "Luxi Mono" "MS Sans Serif" "System"
         }
     }
 }

 #   substitute to "font families" : returns a restricted list
 proc ::chf_families {} {
     ::chf_initfamilies
     set families {}
     foreach fam [font families] {
         if { [lsearch $::chf_validfonts $fam] != -1 } {
             lappend families $fam
         }
     }
     return [lsort $families]
 }

 #   init position from parent
 proc ::chf_initposition {} {
     set parentgeom [winfo geometry $::chf_parent]
     set pluspos [string first + $parentgeom]
     set cornergeom [string range $parentgeom $pluspos end]
     wm geometry .chf $cornergeom
 }

 #   validate and quit
 proc ::chf_ok {} {
     ::chf_makefontstr
     set ::chf_changed 1
     ::chf_quit
 }

 #   cancel and quit
 proc ::chf_cancel {} {
     set ::chf_changed 0
     ::chf_quit
 }

 #   quit
 proc ::chf_quit {} {
     grab release .chf
     if { $::chf_grabprev != "" } {
         grab set $::chf_grabprev
         focus -force $::chf_grabprev
     }
     destroy .chf
 }

 #   this proc changes the font. It is called by various methods, so
 #   the only parameter we are guaranteed is the first one since
 #   we supply it ourselves...
 proc ::chf_changefont {w args} {
     foreach foo [list family size weight underline slant overstrike] {
     if { [set ::chf_$foo] == ""} {
         return
     }
     }
     set ::chf_fontspec [list \
         -family     $::chf_family \
         -size       $::chf_size \
         -weight     $::chf_weight \
         -underline  $::chf_underline \
         -slant      $::chf_slant \
         -overstrike $::chf_overstrike \
     ]
     $w configure -font $::chf_fontspec
 }

 #   change font specification to font string
 proc ::chf_makefontstr {} {
     catch {font delete chf_font}
     eval font create chf_font $::chf_fontspec

     set ::chf_fontstr {}
     #   family
     lappend ::chf_fontstr [font actual chf_font -family]
     #   size
     lappend ::chf_fontstr [font actual chf_font -size]
     #   bold ?
     set weight [font actual chf_font -weight]
     if { $weight != "normal" } {
         lappend ::chf_fontstr $weight
     }
     #   italic ?
     set slant [font actual chf_font -slant]
     if { $slant != "roman" } {
         lappend ::chf_fontstr $slant
     }
 }

 #   main proc
 proc ::chf_call {} {

     # this lets us be reentrant...
     destroy .chf
     toplevel .chf

     if { ! [info exists ::chf_parent] } {
         set ::chf_parent .
     }
     wm transient .chf $::chf_parent
     set ::chf_grabprev [grab current]
     grab set .chf

     # bind window manager close event
     wm protocol .chf WM_DELETE_WINDOW ::chf_cancel

     # define minimal size
     wm minsize .chf 400 160

     # initialize position from parent
     ::chf_initposition

     # get values from font string or set default values
     if { [info exists ::chf_fontstr] } {
         set ::chf_size      [font actual $::chf_fontstr -size]
         set ::chf_family    [font actual $::chf_fontstr -family]
         set ::chf_slant     [font actual $::chf_fontstr -slant]
         set ::chf_weight    [font actual $::chf_fontstr -weight]
         set ::chf_overstrike    [font actual $::chf_fontstr -overstrike]
         set ::chf_underline     [font actual $::chf_fontstr -underline]
     } else {
         set ::chf_size       12
         set ::chf_family     [lindex [lsort [::chf_families]] 0]
         set ::chf_slant      roman
         set ::chf_weight     normal
         set ::chf_overstrike 0
         set ::chf_underline  0
     }

     if { ! [info exists ::chf_title] } {
         set ::chf_title ""
     }
     wm title .chf $::chf_title

     # the main two areas: a frame to hold the font picker widgets
     # and a label to display a sample from the font
     set fp [frame .chf.fontpicker]
     set msg [label .chf.msg -borderwidth 2 -relief groove -width 30 -height 4]
     set fbut [frame .chf.bot]

     pack $fp -side top -fill x
     pack $msg -side top -fill both -expand y -pady 2
     pack $fbut -side top -fill x

     $msg configure -text [join [list \
         "ABCDEFGHIJKLMNOPQRSTUVWXYZ" \
         "abcdefghijklmnopqrstuvwxyz" \
         "0123456789~`!@#$%^&*()_-+=" \
         "{}[]:;\"'<>,.?/"] "\n"]

     # this will set the font of the message according to our defaults
     chf_changefont $msg

     # font family...
     if { ! [info exists ::chf_famlabel] } {
         set ::chf_famlabel ""
     }
     label $fp.famLabel -text $::chf_famlabel
     combobox $fp.famCombo \
         -textvariable chf_family \
         -editable false \
         -highlightthickness 1 \
         -command [list chf_changefont $msg]

     pack $fp.famLabel -side left
     pack $fp.famCombo -side left -fill x -expand y

     # we'll do these one at a time so we can find the widest one and
     # set the width of the combobox accordingly (hmmm... wonder if this
     # sort of thing should be done by the combobox itself...?)
     set widest 0
     foreach family [lsort [::chf_families]] {
     if {[set length [string length $family]] > $widest} {
         set widest $length
     }
     $fp.famCombo list insert end $family
     }
     $fp.famCombo configure -width $widest

     # the font size. We know we are puting a fairly small, finite
     # number of items in this combobox, so we'll set its maxheight
     # to zero so it will grow to fit the number of items
     if { ! [info exists ::chf_sizelabel] } {
         set ::chf_sizelabel ""
     }
     label $fp.sizeLabel -text $::chf_sizelabel
     combobox $fp.sizeCombo \
         -highlightthickness 1 \
         -maxheight 0 \
         -width 3 \
         -textvariable chf_size \
         -editable true \
         -command [list chf_changefont $msg]

     pack $fp.sizeLabel -side left
     pack $fp.sizeCombo -side left
     eval $fp.sizeCombo list insert end [list 6 7 8 9 10 12 14 16 18 20 24 28 32 36]

     # a dummy frame to give a little spacing...
     frame $fp.dummy -width 5
     pack $fp.dummy -side left

     # bold
     set bold "bold"
     checkbutton $fp.bold -variable ::chf_weight -indicatoron false \
         -onvalue bold -offvalue normal \
         -text "B" -width 2 -height 1 \
         -font {-weight bold -family Times -size 10} \
         -highlightthickness 1 -padx 0 -pady 0 -borderwidth 1 \
         -command [list chf_changefont $msg]
     pack $fp.bold -side left

     # italic
     checkbutton $fp.italic -variable ::chf_slant -indicatoron false \
         -onvalue italic -offvalue roman \
         -text "I" -width 2 -height 1 \
         -font {-slant italic -family Times -size 10} \
         -highlightthickness 1 -padx 0 -pady 0 -borderwidth 1 \
         -command [list chf_changefont $msg]
     pack $fp.italic -side left

     # underline
     #   checkbutton $fp.underline -variable ::chf_underline -indicatoron false \
     #       -onvalue 1 -offvalue 0 \
     #       -text "U" -width 2 -height 1 \
     #       -font {-underline 1 -family Times -size 10} \
     #       -highlightthickness 1 -padx 0 -pady 0 -borderwidth 1 \
     #       -command [list chf_changefont $msg]
     #   pack $fp.underline -side left

     # overstrike
     #   checkbutton $fp.overstrike -variable ::chf_overstrike -indicatoron false \
     #       -onvalue 1 -offvalue 0 \
     #       -text "O" -width 2 -height 1 \
     #    -font {-overstrike 1 -family Times -size 10} \
     #    -highlightthickness 1 -padx 0 -pady 0 -borderwidth 1 \
     #       -command [list chf_changefont $msg]
     #   pack $fp.overstrike -side left

     # bottom buttons
     if { ! [info exists ::chf_butok] } {
         set ::chf_butok "OK"
     }
     button .chf.bot.ok -text $::chf_butok -width -12 -command "::chf_ok"
     # pack .chf.bot.ok -side top -padx 4 -pady 4
     grid .chf.bot.ok -row 0 -column 0 -padx 4 -pady 4
     if { ! [info exists ::chf_butcancel] } {
         set ::chf_butcancel "Cancel"
     }
     button .chf.bot.cancel -text $::chf_butcancel -width -12 -command "::chf_cancel"
     # pack .chf.bot.cancel -side top -padx 4 -pady 4
     grid .chf.bot.cancel -row 0 -column 1 -padx 4 -pady 4

     # put focus on the first widget
     catch {focus $fp.famCombo}

     return ""
 }

VWa


Catégorie Exemple | Catégorie Interface utilisateur