====== #!/bin/sh # \ exec wish "$0" -- "$@" package require Tk set i {} proc color {type} { global i set color [tk_chooseColor -initialcolor [$i.text cget -$type]] if {$color != ""} {$i.text configure -$type $color} } proc fontupdate {type args} { global i font switch $type { scale { font configure font -size $args font configure fontb -size $args -weight bold } font { font configure font -family $font font configure fontb -family $font -weight bold } } } if {![winfo exists .$i]} {toplevel .$i} .$i configure -bd 2 -relief raised wm title .$i "Font Viewer" wm geometry .$i 350x200 frame $i.bottom text $i.text -background white frame $i.bottom.1 -relief groove -bd 2 frame $i.bottom.2 -relief groove -bd 2 scale $i.bottom.1.size -from 6 -to 22 -orient h -command [list fontupdate scale] button $i.bottom.2.fg -text Foreground -command "color foreground" button $i.bottom.2.bg -text Background -command "color background" set menu [tk_optionMenu $i.bottom.1.font font "Choose a font"] pack $i.bottom -side bottom -fill both pack $i.text -fill both pack $i.bottom.1.font -pady 3 pack $i.bottom.1.size grid $i.bottom.1 $i.bottom.2 -pady 5 -padx 5 -ipady 5 -ipadx 5 -sticky ns grid columnconfigure $i.bottom {0 1} -weight 1 grid $i.bottom.2.fg -sticky nesw -pady 3 grid $i.bottom.2.bg -sticky nesw -pady 3 font create font -family fixed font create fontb -family fixed -weight bold $i.text configure -font font $i.text tag configure bold -font fontb $i.text tag configure underline -underline 1 $i.text insert end {normal } {} {bold} bold { } {} {underline} underline { } {} {both} {bold underline} $i.text configure -state disabled $menu delete 0 foreach x [lsort -dictionary [font families]] { $menu add radiobutton -label $x -variable font -command [list fontupdate font] } $i.bottom.1.size set 14 # --[AF] 22-06-03 ====== ---- See also: [font] <> Characters | GUI