Meka][Meka Unstopable Posts: 700
|
Code: | proc ok {} { puts [getXLFD] exit } proc getXLFD {} { global bold italic fontsize set fstring "" set facename [.fontname get [.fontname curselection]] if {$bold} { set fstring "*-$facename-bold" } else { set fstring "*-$facename-medium" } if {$italic} { if {$facename == "Helvetica" || $facename == "Courier"} { set fstring "$fstring-o-normal--$fontsize-*" } else { set fstring "$fstring-i-normal--$fontsize-*" } } else { set fstring "$fstring-r-normal--$fontsize-*" } return $fstring } proc resetFont {} { .preview configure -font [getXLFD] } proc changeSize y { global fontsize if [regexp {^[0-9]+$} $fontsize] { set fontsize [expr $fontsize-$y] } else { set fontsize 1 } } proc help {} { puts "no built-in help support" } option add *font -adobe-helvetica-medium-r-normal--14-140-75-75-p-77-iso8859-1 wm geometry . 346x334 bind all <KeyPress-F1> help label .namel -text "Name:" place .namel -x 8 -y 4 -width 64 -height 32 listbox .fontname -relief sunken -yscrollcommand ".fnsb set" scrollbar .fnsb -relief sunken -command ".fontname yview" place .fontname -x 16 -y 36 -width 184 -height 140 place .fnsb -x 200 -y 36 -width 16 -height 140 foreach name {Charter Clean Courier Helvetica Lucida LucidaBright\ LucidaTypewriter {New Century Schoolbook} Symbol Times\ fixed terminal} { .fontname insert end $name } bind .fontname <ButtonRelease-1> resetFont label .sizel -text "Size:" place .sizel -x 224 -y 40 -width 48 -height 32 set fontsize 14 entry .fontsize -relief sunken -textvariable fontsize place .fontsize -x 272 -y 40 -width 40 -height 32 scrollbar .sb -command changeSize place .sb -x 312 -y 36 -width 22 -height 40 label .stylel -text "Style:" place .stylel -x 224 -y 104 -width 52 -height 32 set bold 0 set italic 0 checkbutton .bold -text "Bold" -variable bold -command resetFont place .bold -x 276 -y 104 -width 60 -height 28 checkbutton .italic -text "Italic" -variable italic -command resetFont place .italic -x 276 -y 132 -width 60 -height 28 label .previewl -text "Preview:" place .previewl -x 12 -y 200 -width 76 -height 32 set previewtext "Sample text" entry .preview -relief sunken -textvariable previewtext place .preview -x 84 -y 200 -width 246 -height 72 button .ok -text "OK" -command ok place .ok -x 13 -y 288 -width 96 -height 36 button .cancel -text "Cancel" -command exit place .cancel -x 129 -y 288 -width 96 -height 36 button .help -text "Help" -command help place .help -x 238 -y 288 -width 96 -height 36 |
|