JOB 18-03-06, here is another kind of font chooser dialog with some kind of "live preview" of the available (build in) font styles. The dialog is based on tablelist 6.0.1 which is required for the search functionality (tablelist configure -colorizecommand).
Here is the code:
# ------------------------------------------------------------------------
# fontseldialog.tcl ---
# ------------------------------------------------------------------------
# (c) 2017, Johann Oberdorfer - Engineering Support | CAD | Software
# johann.oberdorfer [at] gmail.com
# www.johann-oberdorfer.eu
# ------------------------------------------------------------------------
# This source file is distributed under the BSD license.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
# See the BSD License for more details.
# ------------------------------------------------------------------------
# Purpose:
# Create a tableview and show the available font styles
# in 2 columss name / fixed font / formatted_text...
# ------------------------------------------------------------------------
package require Tk
package require -exact tablelist_tile 6.0.1
package provide fontseldialog 0.1
namespace eval fontseldialog {
variable widgetDefaults
variable widgetImages
variable widgetVars
array set widgetDefaults {
title "Font Selection Dialog"
font ""
}
# initializing required images...
set this_dir [file dirname [info script]]
set image_dir [file join $this_dir "images"]
set image_file [file join $this_dir "ImageLib.tcl"]
proc LoadImages {image_dir {patterns {*.gif}}} {
foreach p $patterns {
foreach file [glob -nocomplain -directory $image_dir $p] {
set img [file tail [file rootname $file]]
if { ![info exists images($img)] } {
set images($img) [image create photo -file $file]
}
}}
return [array get images]
}
if { [file exists $image_file] } {
source $image_file
array set widgetImages [array get images]
} else {
array set widgetImages [LoadImages \
[file join $image_dir] {"*.gif" "*.png"}]
}
proc GetFontInformation {} {
variable widgetDefaults
variable widgetVars
# make shure to create fonts + data list only once
if {[info exists widgetVars(font_info)] &&
[llength $widgetVars(font_info)] > 0} {
return $widgetVars(font_info)
}
set widgetVars(font_info) [list]
foreach font [lsort -dictionary [font families]] {
# top and bottom spacing for this font is very big,
# so let's filter out this specific font:
if {$font == "Cambria Math"} { continue }
set fid [font create -family $font]
set fmetrics ""
if {[font metrics $fid -fixed]} {
set fmetrics "*"
}
lappend widgetVars(font_info) \
[list [string trim $font] $fmetrics $widgetDefaults(sampletxt) $fid]
}
return $widgetVars(font_info)
}
proc ShowFont {fname fid} {
variable widgetVars
wm title $widgetVars(this) "Font selection dialog - $fname"
# $widgetVars(wlabel) configure -font $fid
}
proc CancelCmd {} {
variable widgetVars
set widgetVars(is_ok) 2
}
proc OKButtonCmd {} {
variable widgetVars
set widgetVars(is_ok) 1
}
proc EnableOkButtonCmd {} {
variable widgetVars
$widgetVars(ok_button) configure -state normal
}
proc DisableOkButtonCmd {} {
variable widgetVars
$widgetVars(ok_button) configure -state disabled
}
proc EntryBindingsCmd {tbl {mode "default"}} {
variable widgetDefaults
variable widgetVars
switch -- $mode {
"default" {
set widgetVars(combobox_var) ""
set searchtxt [string trim $widgetVars(entry_var)]
# if {$searchtxt == "" } { return }
}
"refresh" {
# force refresh
set widgetVars(entry_var) ""
set widgetVars(combobox_var) ""
set searchtxt ""
}
"combo" {
set widgetVars(entry_var) ""
set searchtxt [string trim $widgetVars(combobox_var)]
}
default {
return -code error \
"programmer's error: unknown $mode in proc EntryBindingsCmd"
}
}
$tbl selection clear 0 end
$tbl delete 0 end
set idx 0
foreach item [GetFontInformation] {
set font [lindex $item 0]
set fid [lindex $item end]
if { $searchtxt == "" || \
[string first $searchtxt $font] != -1} {
$tbl insert end $item
$tbl cellconfigure "$idx,2" -font $fid
incr idx
}
}
$widgetVars(wstatus_label) configure -text \
"There are $idx fonts available."
DisableOkButtonCmd
}
proc TextSearch {w string tag} {
$w tag remove $tag 0.0 end
if {$string == ""} {
return
}
set cur 0.0
while 1 {
set cur [$w search -count length $string $cur end]
if {$cur == ""} {
break
}
$w tag add $tag $cur "$cur + $length char"
set cur [$w index "$cur + $length char"]
}
}
# recursive function
proc WinfoGetAllTextWidgets {wparent wlist} {
upvar $wlist widget_list
foreach w [winfo children $wparent] {
if { [winfo class $w] == "Text" } {
lappend widget_list $w
}
WinfoGetAllTextWidgets $w widget_list
}
}
proc ColorizeCmd {tbl textWidget key row col tabIdx1 tabIdx2 inStripe selected} {
variable widgetVars
if {! [info exists widgetVars(entry_var)] ||
[winfo class $textWidget] != "Text" } {
return
}
# -development-
# set wtext_list [list]
# WinfoGetAllTextWidgets $tbl wtext_list
# puts "There are [llength $wtext_list] text widgets available."
# foreach wtext $wtext_list { puts $wtext }
set searchtxt [string trim $widgetVars(entry_var)]
if {[string length $searchtxt] <= 1} {
return
}
# #ce5555 / White
$textWidget tag configure search \
-background LightYellow -foreground Black
TextSearch $textWidget $searchtxt search
}
proc ComboBoxSelectedCmd {tbl w} {
EntryBindingsCmd $tbl "combo"
}
# -------------------------------------------------------------------------
# gui declaration
# -------------------------------------------------------------------------
proc fontseldialog {args} {
variable widgetDefaults
variable widgetImages
variable widgetVars
# "entia non sunt multiplicanda praeter necessitatem"
# - (use) no more things than necessary"
array set widgetDefaults {
sampletxt "Entia non sunt multiplicanda praeter necessitatem."
}
set wparent ""
set ind 0
while { $ind < [llength $args] } {
switch -exact -- [lindex $args $ind] {
"-parent" {
incr ind
set wparent [lindex $args $ind]
incr ind
}
"-title" {
incr ind
set widgetDefaults(title) [lindex $args $ind]
incr ind
}
"-font" {
incr ind
set widgetDefaults(font) [lindex $args $ind]
incr ind
}
default {
puts "unknown option [lindex $args $ind]"
return ""
}
}
}
set w $wparent.fontseldialog
set widgetVars(this) $w
catch {destroy $w}
toplevel $w -class FontSelDialog
wm title $w widgetDefaults(title)
wm geometry $w "800x650+150+150"
wm transient $w $wparent
bind $w <KeyPress-Escape> "[namespace current]::CancelCmd"
set fmain [ttk::frame $w.main -relief groove]
pack $fmain -side bottom -fill x
ttk::button $fmain.chk \
-text "Continue with selected font..." \
-compound left \
-image $widgetImages(dialog-ok) \
-command "[namespace current]::OKButtonCmd" \
-state disabled
set widgetVars(ok_button) $fmain.chk
ttk::button $fmain.cancel \
-text "Cancel" \
-image $widgetImages(dialog-close) \
-compound left \
-command "[namespace current]::CancelCmd" \
pack $fmain.chk $fmain.cancel -side left -expand true -padx 4 -pady 4
# --------------------------
# font selection gui
# --------------------------
set f [ttk::frame $w.help -height 20]
pack $f -side bottom -fill x
set widgetVars(wlabelframe) $f
set msg "Hint: You might want to use one of the \"UI\" font styles"
append msg "\nwhich are easy to read and look good for user interfaces."
ttk::label $f.lbl -text $msg
pack $f.lbl -anchor center
set widgetVars(wlabel) $f.lbl
set f [ttk::frame $w.entry]
pack $f -side top -fill x
ttk::label $f.lcombo -text "Filter: "
ttk::combobox $f.combo \
-width 5 -state readonly \
-values [list "" "ExtB" "FB" "MS" "MT" "Sans" "UI" "Hand" "Script" "Light"] \
-textvariable "[namespace current]::widgetVars(combobox_var)"
set widgetVars(wcombobox) $f.combo
ttk::label $f.lbl \
-image $widgetImages(dialog-search)
ttk::entry $f.entry \
-width 40 \
-textvariable "[namespace current]::widgetVars(entry_var)"
set widgetVars(wentry) $f.entry
ttk::button $f.bttn \
-compound left \
-image $widgetImages(dialog-refresh) \
-style Toolbutton
set widgetVars(wentry_bttn) $f.bttn
pack $f.lcombo $f.combo $f.lbl -side left -padx 5 -pady 5
pack $f.entry -side left -padx 5 -pady 5 -fill x -expand true
pack $f.bttn -side left -padx 2
set tf $w.tf
ttk::frame $tf
set tbl $tf.tbl
set vsb $tf.vsb
tablelist::tablelist $tbl \
-columns {
0 "Font Name" left
0 "fixed" center
0 "Sample text" left
0 "Font ID" right } \
-labelcommand tablelist::sortByColumn \
-yscrollcommand [list $vsb set] -width 0 \
-spacing 1 \
-showseparators yes \
-selectmode single \
-font APP_FONT_STD_NORMAL \
-stripebackground #E0E8F0 \
-selectbackground #A9D0F5 \
-stretch all
$tbl configure -colorizecommand "[namespace current]::ColorizeCmd"
$tbl columnconfigure end -hide yes
ttk::scrollbar $vsb -orient vertical -command [list $tbl yview]
grid $tbl -row 0 -rowspan 2 -column 0 -sticky news
grid $vsb -row 0 -rowspan 2 -column 1 -sticky ns
grid rowconfigure $tf 1 -weight 1
grid columnconfigure $tf 0 -weight 1
pack $tf -side top -expand yes -fill both
set f [ttk::frame $w.status]
pack $f -side top -fill x
ttk::label $f.status
# -image $widgetImages(dialog-search)
set widgetVars(wstatus_label) $f.status
pack $f.status -anchor center -padx 5 -pady 5
bind [$tbl bodypath] <Motion> {+
set t [winfo parent %W]
set x [expr {%x + [winfo x %W]}]
set y [expr {%y + [winfo y %W]}]
# enable move-over effect,
focus $t
$t configure -activestyle frame
$t activate "@$x,$y"
::fontseldialog::ShowFont \
[lindex [$t get "@$x,$y"] 0] \
[lindex [$t get "@$x,$y"] end]
}
bind [$tbl bodypath] <Leave> {+
set t [winfo parent %W]
$t configure -activestyle none
}
bind [$tbl bodypath] <ButtonRelease-1> {+
set t [winfo parent %W]
set x [expr {%x + [winfo x %W]}]
set y [expr {%y + [winfo y %W]}]
# if a tablelist has only a few entries, an "empty area"
# is shown after the last row
# the following if clause ensures that a click in
# this area simply has no effect
set row [lindex [split [$t containingcell $x $y] ","] 0]
if {$row == -1} {
::fontseldialog::DisableOkButtonCmd
} else {
set cell [$t nearestcell $x $y]
::fontseldialog::EnableOkButtonCmd
}
}
bind [$tbl bodypath] <Double-ButtonPress-1> "[namespace current]::OKButtonCmd"
bind $widgetVars(wentry) \
<KeyRelease> "[namespace current]::EntryBindingsCmd $tbl"
$widgetVars(wentry_bttn) configure \
-command "[namespace current]::EntryBindingsCmd $tbl refresh"
bind $widgetVars(wcombobox) <<ComboboxSelected>> \
"[namespace current]::ComboBoxSelectedCmd $tbl %W"
# ---------------------------
# fill tablelist with content
# ---------------------------
set default [lindex [$tbl configure -font] 3]
set idx 0
foreach item [GetFontInformation] {
set font [lindex $item 0]
set fid [lindex $item end]
$tbl insert end $item
$tbl cellconfigure "$idx,2" -font $fid
incr idx
}
$widgetVars(wstatus_label) configure -text \
"There are $idx fonts available."
# perform font name preselection (if any)
# ---------------------------------------
if { $widgetDefaults(font) != ""} {
# try to find font name and calculate index
set data [list]
foreach litem [$tbl get 0 end] {
lappend data [lindex $litem 0]
}
if { [set idx [lsearch $data $widgetDefaults(font)]] != -1 } {
# bummer !
$tbl selection set $idx
$tbl see [expr {$idx -3}]
EnableOkButtonCmd
}
}
after 6000 "catch {pack forget $widgetVars(wlabelframe)};"
# --------------------------
# --------------------------
# wait user
grab $widgetVars(this)
tkwait variable "[namespace current]::widgetVars(is_ok)"
grab release $widgetVars(this)
if { $widgetVars(is_ok) == 1 } {
# read actual selection:
set sel [$tbl curselection]
set retval [string trim [lindex [$tbl get $sel] 0]]
} else {
set retval ""
}
# clean fonts before leaving the dialog (if that matters)...
foreach item [GetFontInformation] {
set fid [lindex $item end]
set widgetVars(font_info) [list]
catch {font delete $fid}
}
destroy $widgetVars(this)
return $retval
}
}
set dir [file dirname [info script]]
set auto_path [linsert $auto_path 0 [file join $dir "."]]
set auto_path [linsert $auto_path 0 [file join $dir ".."]]
set auto_path [linsert $auto_path 0 [file join $dir "../../lib"]]
# test-run ...
package require Tk
package require tile
package require -exact tablelist_tile 6.0.1
package require fontseldialog 0.1
wm withdraw .
set showconsole 0
if { $showconsole && $::tcl_platform(platform) == "windows"} {
console show
console eval {wm protocol . WM_DELETE_WINDOW {exit 0}}
}
set rval [fontseldialog::fontseldialog \
-parent "" \
-title "Select Font Style:" \
-font "Comic Sans MS" \
]
puts "Selection return value is: \"$rval\""package ifneeded fontseldialog 0.1 \
[list source [file join $dir fontseldialog.tcl]]# ImageLib.tcl ---
# Automatically created by: CreateImageLib.tcl
set images(dialog-clear) [image create photo -data {
iVBORw0KGgoAAAANSUhEUgAAABQAAAAUCAYAAACNiR0NAAAABmJLR0QA/wD/AP+gvaeTAAAACXBI
WXMAABGwAAARsAHIJ/VUAAAAB3RJTUUH4QEaCTEiD+SBFQAAA0tJREFUOMu1lM9vVFUUx79vOvOm
M9MOLWJKpAmx7T+g3WioUMvYuBPSCIQ0uDASVyzY6J8gCxPiT4hglNB2OsO0aaJxeH3zyxh/YRWw
UrugKKhtdDozjzrvzbx73/26qNO0UIREPclZ3JNzPjnn3vO9Gkn8l+a7M+BJCSnFPxYppeC67v2B
nvIwOZXixGSKnvLuCczmTH5w7iylEPcGKqWQSMb5yI4d6OzsRDIZp9oEaphpCiHw5BO7cPrMu3TF
HZ2ShOPUcH7kQ37+xWdsWCZrMp4YJUk03MwaHE+M0BUuSXJ+fo7vnHqTjmOv5fgAwO9vgq4H0Xgg
IQUGnt6Lh7dtQyK12qlhprm4+CsOPH8YtlMFQWja6p2760dvkD1PYix+ntnsNEnSqTkkyWkzzZNv
vM6x8RGS5O0Vi1JKXv3+Ct96+yTrbh3rp9hwkJ7E2PgozYxBkrQdmySZy2dIktZKmcIT/OrSl3zv
7Cm6rruh/i5gwxMXxmiY6b8hFdq1KkvlIl23zkszX3Nk9Bwtq7JprW+ztRjaf0C79sMsCp/mEPD7
UbHKAIAbCzeQyRgYHHx2Jhrd8mCLDQCZrMGOju3Y/VQ/bMeGHtBRFwI7H92Jxx/rRaGQ6/U88WDA
bM7k0tIiDh48DGulgnCoBX/8vowtrVFYt0vo69sDv9+PickU7wucNtNcWvoNw8MvoGyV0KwHceXy
d5iaSqFQyCMSboW1UsLA3hj0oI7khTiVUncDhRBIpz9mvV7H/n1DWC4V0RwM4ZtvZ7Dw0wKOvvTy
Cdu2YUxfRKg5gkqlhD39/QhHwkhNJCjWqcUHAFTErV9uoaNjO5pDIUTCLZidvYq5a7OIDcQQbW17
NRYb1Ny6i1wui0ikBT7Nh57uHvw4P4c/q9VYA6g11FG1qzjz/mn27doNDUQ+n8ehQ8MI6sETtZrz
SjAYTJLo+uTiR71t7W3o6e5BMjGOY8eOP9Pe1m6uAZVSEEJAColKpcxkKg5N82Hfc0OIRqPdTU1N
C7quQ0oJIWSXY1evG2YaN2/+jCNHXsRDW7dquq4jEAhA07TVxW5AhRAolZaPlsvlLiEEpJQblSQl
hBCwLAvFYvE1ISRc14VSai1H+99/7H9rfwF2imSw0yqcowAAAABJRU5ErkJggg==
}]
set images(dialog-close) [image create photo -data {
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QAAAAAAAD5Q7t/AAAACXBI
WXMAAA3XAAAN1wFCKJt4AAAACXZwQWcAAAAQAAAAEABcxq3DAAACR0lEQVQ4y6VTQU/iQBh9U7qQ
lrYYg7uLlOXA3kyMRy9rW7xx4LQHf2LPvRETbfXkgcSQGE8eQFi2Io20WCyd6ezBhYgHL36nyffe
fPneezOEc47PlLg6uJYl5mYzG4SAadqJeX5O3xJdyxJzYWgD2MCFFUimU0euVltytdoi06njWtbG
cBIETlHXW7Kut0gQrHERAPhkYiu1mlk7PpZACAadjjnv9x3XstoAgIcHp1ivm3qzKYFzDDodM7q/
twH8FgEgoxTZcolssUAWhtANQxqcnprRcOgAgKrrpm4YEvV9CJr2ymUMAEA453AJEdNGw1ErFbPe
bEpZFEHQNNx73jMA1AyjmEURBEXB4OwsDsdj78vdXdvknJJVCi4hYlKvO2qlYvw4OpKz+Rw5VQUA
sDCEoKoYXFzE0XjsFfr9tsk5XW+wNosQcaHrjra7+6t6eKiA/g9CFDG6upqHo9GlNByuL2/EuCpG
KehyCbpYAFn22kxT0CQBo/Q9HRsSwp0dRy6XjerBgZwlCXKS9Dr05QVCPo/R9XUcPz562mSyKcEl
RHza3nbkrS3j+/6+zJdLkHweDzc3cwD4urenrHp/e704fnrytoKgbXJOBQAISiU7Xywa5UZDTmcz
MEox7Hbjme9fznz/ctjtxoxSpGGIcqMh54tFIyiV7LUHjDGwNEUaxwCAye1t/BJFXvn5uQ0Aj4w5
f3o9Y+fnTxmcI0tTsPfvwC8UnIKiGACQzOfetyRZ6/wI3zBxnMvZAFBh7ORtVB/h5LPf+R+0911L
hE5qiwAAACV0RVh0ZGF0ZTpjcmVhdGUAMjAxMC0wMi0xN1QwNzowMzozMy0wNzowMBY/EYkAAAAl
dEVYdGRhdGU6bW9kaWZ5ADIwMTAtMDEtMTFUMDk6MTI6NDItMDc6MDDvvfybAAAANHRFWHRMaWNl
bnNlAGh0dHA6Ly9jcmVhdGl2ZWNvbW1vbnMub3JnL2xpY2Vuc2VzL0dQTC8yLjAvbGoGqAAAABl0
RVh0U29mdHdhcmUAd3d3Lmlua3NjYXBlLm9yZ5vuPBoAAAATdEVYdFNvdXJjZQBHTk9NRS1Db2xv
cnOqmUTiAAAAMXRFWHRTb3VyY2VfVVJMAGh0dHA6Ly9jb2RlLmdvb2dsZS5jb20vcC9nbm9tZS1j
b2xvcnMvUB216wAAAABJRU5ErkJggg==
}]
set images(dialog-ok) [image create photo -data {
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QA/wD/AP+gvaeTAAAACXBI
WXMAABGwAAARsAHIJ/VUAAAAB3RJTUUH4gMCEiUV4H3hYAAAAfJJREFUOMulk1tI03EUxz+/XZi7
OOlvWGLRBYmgYAbaGgiVUMgcVA89lC9JIvXQZUGjCEIIgiAcjB4iih6iXjKCSPKphzKDkuWg2Lz0
8G+rzVVb0cLm1NNDW0imLTxPB37n+zm331EiwlLMwBKtbED37XY5FNwk9wevip6M+f8LEIuHZWrm
Eyf3B/jyY4RQ37Ge0pvpX2LXaWXfuspNh+8AEf0hJuM6NtZtK7+Fs23BXEO9i7HUIKu1LTyNPMHb
1BEqC9D38m7DgxchVtZUYFI2Hj3vp6v1InXL15+YBxhNDEtn0CMTmcTvvT57fe9Vm8dLMjNKYdLC
zLSNxg0tam4SE0A6m5Bzt7zsa95L4OZOWlwdUl1Zy6wkyeXzOK0rGIgM0X2wd16VSkQIXN8jmjZF
daUdEQOJ9Gei+jt2NbmZLKT5+g1qHG6O+C6ovwIA/NdaBbKsqdWYljwOyzKyuQ+YjRrh2Dh3zoyo
RT9SsKtfbd/cyePwAFIw8DETx6QsxPS3HPVdXnDQ6s9bGE+8kUu9h6lyfMdoMGC3NHK+/YZSShkA
BczKXFHRV4AZsHrosabSSTl+Zbc0n0L0uC6p9xPD0WjUD1QB1mLsr+QiUoIYi1uxrmVHxRBiFsSs
Ue8EnICtKDYBxpJOLXbOSilVrHLBoJ+h/c25hpqBXwAAAABJRU5ErkJggg==
}]
set images(dialog-refresh) [image create photo -data {
iVBORw0KGgoAAAANSUhEUgAAABYAAAAWCAYAAADEtGw7AAAABmJLR0QAAAAAAAD5Q7t/AAAACXBI
WXMAAA3XAAAN1wFCKJt4AAAACXZwQWcAAAAWAAAAFgDcxelYAAAD1UlEQVQ4y7WUTWxVRRSAv3Pv
fX2vrX30V6CFtggqUUuEACYqYSPBRBISo9GFGhe6Ihij7khcYGKIPwtdCTUujGIibHSjgaiJGgkY
UcGFQJG0tFADNIX2te/eOTPHxa2vvHYncZJJbmbO/WbmO2dGzIz/oyUAm178ZFsURx96H3pvBRbH
0Ujw4YWfB585mgAgDD68YVVvf08HcRwRR7KoRwIigpkRDHywRf3C6LXe70+cGwT6EwCvvm95V5lz
YzdICjHJHDyJbwJHggAGhJtg6ue+fWDl7Utw6vtqKsxCHmyBKAhBBBHYtKaD9ava6CwXqaTK6NVZ
fvlrgpErMwTLgYVE0DTgQ97NwrxjC4bTQPCGF0Mk8PSWfjaubq/5a2yI6Wwpcv+qVv4cu8Hhn0aZ
dcpzW/v54OtzeG+oGhbsJrAZ6gPqPQis62+tgy5sa3vKvPTYnfx9vcqa5S049agPOO/5t8pqKpx6
vM+PsXl1mWBGZSZl/+HvmLhRoburlae2P0BXWwsA5aYC5aYCAKoBVY+qr6mI5lXkE94H7unrIBKh
sVTg9CXPVW3n5HDKrn2f8fGXP1LNXN0JnPOoBjLnF6rIB1U9EYZTpZDExFFMsaUDEaGh2ETbbW1c
nFSSOF4AdmgwnPMLkmf5oFOPhcDLew8wNF5BBHrvewgRAWBlVzOvPDFAEkd14EzzikidLnAcAlmm
OPWEKOLAm7vrfpzNlDcO/sqZC5fZsesoYS5JNqdxYPNWxidmSF2+sbodp05R57Ek1EHVB/a8d5jh
6SaSYhOdd2zADD7f80gt5ofTY7x96HdcNr/jqOY4U5wqqvVgp5716+6lodhIlmke57Q2H0Jg5OIY
zvk5FQsuSDVTnPNg9eDGYoFntw+w48G7OPjtWU4OXeHuntY5qJE5z1fHzuJcM2kaL66KNHM4pwh5
xo+fOk9fdyfLOpcA0NZSZNfOgdqCPgTiKOKPs8MMT0CUeNLMLa6KNFMyp4gYx0+dZ/e+QyTiee35
7Ty+bePiJzKKmJicZu/gEYJ0oE6pZtQci5mxZue71r2ym0pViUWw6YtE5V7AqE5eYkVrxJOPbmbL
xrW0L2mmMpty7Lch3v/0G2YLS4mSIiEYTaWESyNjDH3xqsxfaecIPmAClJYRfECAQrmby2mVdw4e
Y99HRwiagcQUGlsolZeDJHjNy08d9SrARitTlRWlxlJ+GSTKX14RRAyKJRqKPQtkGGaAGYiBGZWp
aSz4cRFpTgBmxs+8Hjr635q6XujkFpppen1q5MR+oE3MDBEpAN3AUmDyP3LbgVlgDLj2D6PDY5hT
ZmYmAAAAJXRFWHRkYXRlOmNyZWF0ZQAyMDEwLTAxLTExVDA5OjEyOjUyLTA3OjAwUkpEuQAAACV0
RVh0ZGF0ZTptb2RpZnkAMjAxMC0wMS0xMVQwOToxMjo1Mi0wNzowMCMX/AUAAAA0dEVYdExpY2Vu
c2UAaHR0cDovL2NyZWF0aXZlY29tbW9ucy5vcmcvbGljZW5zZXMvR1BMLzIuMC9sagaoAAAAGXRF
WHRTb2Z0d2FyZQB3d3cuaW5rc2NhcGUub3Jnm+48GgAAABN0RVh0U291cmNlAEdOT01FLUNvbG9y
c6qZROIAAAAxdEVYdFNvdXJjZV9VUkwAaHR0cDovL2NvZGUuZ29vZ2xlLmNvbS9wL2dub21lLWNv
bG9ycy9QHbXrAAAAAElFTkSuQmCC
}]
set images(dialog-search) [image create photo -data {
iVBORw0KGgoAAAANSUhEUgAAABYAAAAWCAYAAADEtGw7AAAABmJLR0QAAAAAAAD5Q7t/AAAACXBI
WXMAAA3XAAAN1wFCKJt4AAAACXZwQWcAAAAWAAAAFgDcxelYAAAEVElEQVQ4y7WT209UVxTGv3Xm
DsMwcxhgRIyDVkGMZYy1aRWiVaJtkJvpQ31pbN/atA99aI1RmxBNGPGlf0ANSU1No6maam1VRlCw
iSi1tNXCjBEGGS7OgbngzDlnzpy9++BgjC3oiyv5spK9d35r5dtrEeccryKEV0IFYPyfM2rvONJI
oPcA1HNAJGAcoFEOdnz/Vwd/ehkwPWuF3+93QdC/q6yq2rVxw0aIohtWqxWKLCMWn8WNG714MDJy
nTj7bN++Q3+9FNjv93sFA+9uam72rqhYhfN9w/HuwWn9XnjWsdYrJt+pKTXs2lzpDIcf4Oy5s5Jm
0H0HvjgQebHHBv2b1tbdXrGojLUcupC8GUrO7qqrShz9dNtY7fqV0Yu/Rx81H7yQKBQ9rKmxyW3Q
8ENbW5txIbARANqPtddVLK9oLi9fjtavL87t2fH6RP36pUVmo2DSdKa57JZM5TKX8mPfg+G9Hd1V
5w43OFavXl07HAzuAXBiwY6Js899Ph86f74TXVrqnN5U7bEDHAycA2CCQFmDAFbkzIszMjw8Fbgb
q6nxgYjvWNQKAlYaTUZ03XnE3qgskzWdZRVNl1WNxTXGEpzzpJbVZ6YTmdHSYuf4L7cnsjabDZxh
66JWcGAZYzrGpZRotZpG5EzWxMmgMQgZ4iyjM6j992O3NT2bsedbDAP3I9uzWQ2qmsl70RwrRqMJ
Ze78mVAkwVctdSSJSIaeVTKMRW8FZ/qDE6k0BIiJOWWZaDfNJpPJEjWjPlwczBGQ0/Leel+J4cLt
iEMwGXvFAlsildbGY3I2TAJ/LBBcnME6NR2r2FlTDFVVoanK2OLjJuDXoaF/8FFDjZvrWvnoRKwk
MpuaiymqDAACezLs4QnpNUHX1n/csK7kZn8/VEX9ftGOxcLiM6FQ6Lfq6pFNJ/Zvs3/o79429She
XFLkuGUvsFji8bQrKiXfthr5lhMHttuj0UkMDg5mhoaDsRdu3rFjbR5OloGW5pYyr3clzvcFZ3v+
nNbvjs441y53xbf6PKbGzZXO4eA9dHZ2Ih6PQ5KktMVkazh9+nTPgmAAOHr08DpGwrcrvBVv1tbW
weUUYbXZoMgypBkJPT3duN7bq2QzGWvVmjUoK1uCrq5AStHSTadOnrm6IHg+2juO7CZOn0BAOThK
VVVNyLIaUNT0pUuX++J2u+1cc+O7eUs8HpjMZgQCgZSsplpPnTxzZVHw00ui+Q+mnAAA1Rs2vCU6
HBd31m8p8HiWwGKxoKurKyWrqaedC8+BDERkJiIbEeUDcORUCMA5r3sDA0NTk9H3L1/peTw5NQlV
VVFXV5cvwHiciIxEREIOSERkAmAGYMnJBiAPQD6AglwBJwAXgML7Q38HxyKRDy5fuTYXHgtDkqLQ
s7rT7XbbAJjnN48vIJazQH/m3Xxm4VDoDzCh5WrPjQ6bxVwuCPhSkiQdgP4fj+mJscIzMjyXkSuo
P5fnxTnn+BdfFBTdhrqWWgAAACV0RVh0ZGF0ZTpjcmVhdGUAMjAxMC0wMS0xMVQwOToxMzowMy0w
NzowMFMfKlcAAAAldEVYdGRhdGU6bW9kaWZ5ADIwMTAtMDEtMTFUMDk6MTM6MDMtMDc6MDAiQpLr
AAAANHRFWHRMaWNlbnNlAGh0dHA6Ly9jcmVhdGl2ZWNvbW1vbnMub3JnL2xpY2Vuc2VzL0dQTC8y
LjAvbGoGqAAAABl0RVh0U29mdHdhcmUAd3d3Lmlua3NjYXBlLm9yZ5vuPBoAAAATdEVYdFNvdXJj
ZQBHTk9NRS1Db2xvcnOqmUTiAAAAMXRFWHRTb3VyY2VfVVJMAGh0dHA6Ly9jb2RlLmdvb2dsZS5j
b20vcC9nbm9tZS1jb2xvcnMvUB216wAAAABJRU5ErkJggg==
}]
| [Category Utility Dialog] |
