package req Tk
#=======================================================================#
# SCRIPT : viewIcons.tcl #
# PURPOSE : Display icons from icon library. #
# AUTHOR : Adrian Davis (adrian@satisoft.com). #
#-----------------------------------------------------------------------#
# HISTORY : Mar02 1.00.00 - First release. #
# : Jul02 1.01.00 - Adds clipboard and columns facilities. #
# : Jan29 2006 suchenwi: adapted for PocketPC, simplified #
#=======================================================================#
proc clipInfo {IconName} {
global LIBRARY
set Data {}
set DataWidth 59
set IconData [::icons::icons query -file $LIBRARY -items d $IconName]
while {[string length $IconData] > 0} {
append Data "\n [string range $IconData 0 $DataWidth]"
set IconData [string range $IconData [expr {$DataWidth + 1}] end]
}
set cmd "image create photo \
$IconName -data {[string trimright $Data]\n}\n"
clipboard clear
clipboard append $cmd
bell
}
proc selectIcons w {
global INITIALDIR LIBRARY
set OldLibrary $LIBRARY
set LIBRARY [tk_getOpenFile -initialdir $INITIALDIR \
-initialfile tkIcons -title "Select Icon Library" \
-filetypes {{"Icon Libraries" {tkIcons*}} {"All Files" {*}}}]
if {$LIBRARY eq ""} {
set LIBRARY $OldLibrary
} else {displayIcons $w}
}
proc displayIcons c {
global ICONS LIBRARY
::icons::icons delete $ICONS
$c delete all
set ICONS [::icons::icons create -file $LIBRARY -group *]
set x 10
set dx 28
set y 14
set dy 28
foreach IconInfo [::icons::icons query -file $LIBRARY -group *] {
set IconName [lindex $IconInfo 0]
set id [$c create image $x $y -image ::icon::$IconName]
$c bind $id <1> [list clipInfo $IconName]
if {[incr x $dx] > 210} {incr y $dy; set x 10}
}
$c config -scrollregion [$c bbox all]
}#-------------------- Main code proc iconview args {
package require icons 1.0
if [winfo exists .icons] {raise .icons; focus .icons; return}
global LIBRARY ICONS INITIALDIR c
if [llength $args] {
set INITIALDIR [lindex $args 0]
} else {
set INITIALDIR [file dir [lindex [package ifneeded icons 1.0] 1]]
}
set ICONS {}
set LIBRARY [file join $INITIALDIR tkIcons-sample.kde]
set t [toplevel .icons]
wm title $t "Icons"
label $t.1 -text Lib:
entry $t.2 -width 24 -textvariable LIBRARY
bind $t.2 <Return> displayIcons
button $t.3 -text "Browse" -command {selectIcons $c}
grid $t.1 -row 0 -column 0 -padx 4
grid $t.2 -row 0 -column 1
grid $t.3 -row 0 -column 2 -padx 4 -pady 2 -sticky ew
frame $t.f -borderwidth 0
set c [canvas $t.f.icons \
-yscrollcommand "$t.f.y set" -height 245 -width 220]
bind $t <Up> "$c yview scroll -1 page"
bind $t <Down> "$c yview scroll 1 page"
scrollbar $t.f.y -command "$c yview" -orient vertical
pack $t.f.y -side right -fill y
pack $c -side left -fill both -expand yes
grid $t.f -row 1 -column 0 -columnspan 3 -sticky news
displayIcons $c
raise $t; focus -force $t
catch {wce siphide}
}#-------------- self-test when sourced at toplevel: if {[file tail [info script]] eq [file tail $argv0]} {
wm withdraw .
iconview
bind all <Escape> {exec wish $argv0 &; exit}
bind all <F1> {console show}
}Category Characters - Category Development
