package req Tk #=======================================================================# # SCRIPT : viewIcons.tcl # # PURPOSE : Display icons from icon library. # # AUTHOR : Adrian Davis ([email protected]). # #-----------------------------------------------------------------------# # 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
