Another font chooser dialog - based on tablelist
JOB 18-03-06, here is another kind of font chooser dialog with a "live preview" of the available (build in) font styles. The dialog is based on tablelist, hence the search functionality is implemented with the help of the "configure -colorizecommand" sub-command.
From a functional point of view, the dialog is pretty complete. There is a search and filter option available, which allows to shrink down a long list of entries quite easily. In addition, there is one more column to indicate fixed fonts.
I always wanted to bring such a dialog to live and since then I do not want to miss it either.
Here is the code:
- fontseldialog.tcl
# ------------------------------------------------------------------------
# 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
}
}
- fontseldialog_test.tcl
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\""- pkgIndex.tcl
package ifneeded fontseldialog 0.1 \
[list source [file join $dir fontseldialog.tcl]]- ImageLib.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==
}]