if 0 {
The Windows charmap utility drives me crazy. It has no way I can find to configure the size of the character display - you have to actually click on one and get the little pop-up in order to see the character. Aside from the basic ascii characters, none of the characters are recognizable.
Okay, thanks to AMucha I have changed the code to remove the real bottleneck - huge numbers of font creations. Sometimes you just need someone to point out the obvious. It's much better now.
That said, his suggested code does not seem to work entirely right either. See bottom for symptoms.
}
package require Tk wm withdraw . proc setfont { { name1 "" } { name2 "" } { op "" } } { set fontname [ file tail [ file rootname $::curfont ] ] #tk_dialog .info curfont "curfont=$fontname" "" 0 OK font configure utf8font_16 -family $fontname font configure utf8font_24 -family $fontname } font create utf8font_16 -family Tahoma -size 16 font create utf8font_24 -family Tahoma -size 24 set curfont "Tahoma.ttf" proc relabel { args } { set ::lastscr "" set row $::currow for { set i 0 } { $i < 200 } { incr i } { set r [ expr { int($i/20)+1 } ] set c [ expr { ($i%20)+1 } ] if { $c == 1 } { .top.rowlbl$r configure \ -text [ format %04X [expr {$row+$i}]] } set text [ format %04X [expr {$row+$i}]] if { "0x$text" > "0xffff" } { set text "" } else { eval set char "\\u$text" } .top.btn-$r-$c configure -text $char -font utf8font_16 } } proc insert { w } { set char [ $w cget -text ] .top.entry insert end $char } set currow 0 toplevel .top #bind .top <ButtonPress-3> {tk_dialog .info curfont "curfont=$::curfont ([ file tail [ file rootname $::curfont ] ])" "" 0 OK} wm protocol .top WM_DELETE_WINDOW { exit } # set fontlist [ glob C:/WINDOWS/Fonts/\* ] (lpz 2012 06 25) set fontlist [ glob [file join $::env(Systemroot) Fonts *] ] ttk::combobox .top.fontlist -textvariable ::curfont \ -state readonly -values $fontlist -width 36 bind .top.fontlist <<ComboboxSelected>> setfont label .top.font -text "Font: " -anchor w grid .top.font -row 0 -column 0 -sticky e grid .top.fontlist -row 0 -column 1 -columnspan 21 \ -sticky snew for { set i 1 } { $i <= 20 } { incr i } { for { set j 1 } { $j <= 10 } { incr j } { button .top.btn-$j-$i -width 1 -text "x" \ -command [ list insert .top.btn-$j-$i ] \ -font utf8font_16 grid .top.btn-$j-$i -row $j -column $i -sticky snew } } for { set i 1 } { $i <= 10 } { incr i } { label .top.rowlbl$i -text "NNNN" grid .top.rowlbl$i -row $i -column 0 } scale .top.scale -showvalue 0 -from 0x0000 -to [expr {0xffff-200}] \ -variable currow -resolution 200 bind .top.scale <ButtonRelease-1> relabel grid .top.scale -row 1 -rowspan 11 -column 21 -sticky ns label .top.copy -text "Copy:" grid .top.copy -row 11 -column 0 -sticky e entry .top.entry -font utf8font_24 grid .top.entry -row 11 -column 1 -columnspan 21 -sticky nsew relabel
if 0 {
AMucha 2009 June 04
Hey, "Quick and Dirty, remember? =)
AMG: Braced expressions run quicker. :^)
Carp. I knew it had to be something obvious.
font create utf8font_16 -family Tahoma -size 16 font create utf8font_24 -family Tahoma -size 24 # in your bouttons you use button .top.btn-$j-$i -width 1 -text "x" \ -command [ list insert .top.btn-$j-$i ] \ -font utf8font_16 # if your font changes you only say (once!) font configure utf8font_16 -family [ file rootname $::curfont ] # and automagicaly all your buttons use the new font
Okay, the above code now reflects that. It has the following problems:
.
}
JFL A very useful tool. Thanks for contributing it!
Here's an update with the following changes:
set nCols 32 ; # Number of columns displayed set nRows 16 ; # Number of rows displayed set nPerScreen [expr $nCols * $nRows] set nColsPlus1 [expr $nCols + 1] set nRowsPlus1 [expr $nRows + 1] package require Tk wm withdraw . proc setfont { { name1 "" } { name2 "" } { op "" } } { set fontname [ file tail [ file rootname $::curfont ] ] # tk_dialog .info curfont "curfont=$fontname" "" 0 OK font configure utf8font_16 -family $fontname font configure utf8font_24 -family $fontname } font create utf8font_16 -family Tahoma -size 16 font create utf8font_24 -family Tahoma -size 24 set curfont "Tahoma.ttf" proc relabel { args } { set ::lastscr "" set i $::currow for { set r 1 } { $r <= $::nRows } { incr r } { .top.rowlbl$r configure -text [ format %04X $i ] for { set c 1 } { $c <= $::nCols } { incr c ; incr i } { set text [ format %04X $i ] if { "0x$text" > "0xffff" } { set char "" } else { eval set char "\\u$text" } .top.btn-$r-$c configure -text $char -font utf8font_16 } } } proc insert { w } { set char [ $w cget -text ] .top.entry insert end $char } set currow 0 toplevel .top # bind .top <ButtonPress-3> {tk_dialog .info curfont "curfont=$::curfont ([ file tail [ file rootname $::curfont ] ])" "" 0 OK} wm protocol .top WM_DELETE_WINDOW { exit } # set fontlist [ glob C:/WINDOWS/Fonts/\* ] (lpz 2012 06 25) set fontlist [ glob [file join $::env(Systemroot) Fonts *] ] ttk::combobox .top.fontlist -textvariable ::curfont \ -state readonly -values $fontlist -width 36 bind .top.fontlist <<ComboboxSelected>> setfont label .top.font -text "Font: " -anchor w grid .top.font -row 0 -column 0 -sticky e grid .top.fontlist -row 0 -column 1 -columnspan $nColsPlus1 -sticky snew for { set r 1 } { $r <= $nRows } { incr r } { for { set c 1 } { $c <= $nCols } { incr c } { button .top.btn-$r-$c -width 2 -height 1 -text "x" \ -command [ list insert .top.btn-$r-$c ] \ -font utf8font_16 grid .top.btn-$r-$c -row $r -column $c -sticky snew } } for { set r 1 } { $r <= $nRows } { incr r } { label .top.rowlbl$r -text "NNNN" grid .top.rowlbl$r -row $r -column 0 } scale .top.scale -showvalue 0 -from 0x0000 -to [expr {0xffff-$nPerScreen}] \ -variable currow -resolution $nPerScreen bind .top.scale <ButtonRelease-1> relabel grid .top.scale -row 1 -rowspan $nRows -column $nColsPlus1 -sticky ns bind .top <Home> {set currow 0 ; relabel} bind .top <Prior> {incr currow [expr -$nPerScreen] ; if {$currow < 0} {set currow 0} ; relabel} bind .top <Up> {incr currow [expr -$nCols] ; if {$currow < 0} {set currow 0} ; relabel} bind .top <Down> {incr currow $nCols ; relabel} bind .top <Next> {incr currow $nPerScreen ; relabel} bind .top <End> {set currow [expr {0x10000-$nPerScreen}] ; relabel} label .top.copy -text "Copy:" grid .top.copy -row $nRowsPlus1 -column 0 -sticky e entry .top.entry -font utf8font_24 grid .top.entry -row $nRowsPlus1 -column 1 -columnspan $nColsPlus1 -sticky nsew relabel
MHo 2009-06-22:
set fontlist [ glob C:/WINDOWS/Fonts/\* ]
could be rewritten as
set fontlist [ glob [file join $::env(Systemroot) Fonts *] ]
to make it a little more independent from the characteristic of the windows installation.