This tool enables you to easily convert your GIF images to Base64 text format and copy it to the clipboard, so that you can include the images as inline images in your Tcl 8.0, Tcl Plug-in, or Spynergy Tcl/Tk programs. For Windows systems, you will also need the gifto64.exe DOS executable to be in the same directory that you launch the conversion tool's Tcl script from. For UNIX or Mac systems, you can download and compile your own gifto64 executable using the C source code.
To run this tool, change to the examples directory in your Tcl console and enter source gifto64.tcl
Source code for the Image Conversion Tool:
#------------------------------------------------------------------------------------- # gifto64.tcl -- GIF-to-base64 text conversion utility # # Copyright (c) 1997 Eolas Technologies Inc. # Freely modifiable/redistributable under the "Standard Tcl License" # See http://www.eolas.com/tcl/license.txt for details # proc show { } { global _FC if {$_FC(target) == ""} { fc_error "No file selected" return } else { display $_FC(target) } } proc display { filename } { global _FC destroy .image toplevel .image -background LightGray wm withdraw .image wm title .image "$_FC(file)" frame .image.f -borderwidth 5 -background lightgrey pack .image.f -side top -expand 1 label .image.f.l -background lightgrey pack .image.f.l -side top -anchor nw -padx 2 -pady 2 set d [read_file $filename] set i [image create photo -data $d] .image.f.l configure -image $i button .image.b -text "Close" -command {destroy .image} -activebackground lavender -background gray40 \ -foreground white -highlightbackground LightGray pack .image.b -anchor s -fill none wm deiconify .image } proc display_text { } { global .fc_main.f3.t _FC if {$_FC(target) == ""} { fc_error "No file selected" return } set text [read_file $_FC(target)] .fc_main.f3.t configure -state normal .fc_main.f3.t delete 1.0 end .fc_main.f3.t insert 1.0 $text .fc_main.f3.t configure -state disabled .fc_main.f3.l configure -text "Data for [file tail $_FC(file)]" } proc read_file { filename } { global wd set f [open $filename r] if {![file readable $filename]} { fc_error "File \[$filename\] is not readable." return } set d [read $f] close $f return $d } proc copy_clip { } { global _FC if {$_FC(target) ==""} { fc_error "No file selected" return } set data [read_file $_FC(target)] if {$data ==""} { fc_error "No data in file" } clipboard clear #------------------------------------------- # Add the selected text to the clipboard. #------------------------------------------- clipboard append $data tk_dialog .message "Done!" "$_FC(file) base64 code copied to clipboard" info 0 Close } # directory procs #=================================================================== # File Forms and functions #=================================================================== #---------- # file_convert - convert file selected from directory browser proc file_convert {} { global _FC wd set _FC(file) [fc_loadsave load] if {$_FC(file) == ""} {return} if {![file readable $_FC(file)]} { fc_error "File \[$_FC(file)\] is not readable." return } set _FC(blockflag) 1 .fc_main configure -cursor watch foreach b { .fc_main.f.b1 .fc_main.f.b2 .fc_main.f.b4 .fc_main.f.b5 } { $b configure -state disabled $b configure -foreground grey } update set name [string trimright $_FC(file) .gif] catch "file delete $wd/gifimage.b64" set _FC(target) $wd/gifimage.b64 wm title .fc_main "Converting [file tail $_FC(file)]" #puts $_FC(file) exec $wd/gifto64 $_FC(file) $_FC(target) fc_wait_if_blocked set _FC(packagekeyname) [file tail $_FC(target)] if {$_FC(packagekeyname) == ""} {set _FC(packagekeyname) $_FC(target)} if {$_FC(packagekeyname) == ""} {set _FC(packagekeyname) "UNKNOWN"} set _FC(blockflag) 0 foreach b {.fc_main.f.b1 .fc_main.f.b2 .fc_main.f.b4 .fc_main.f.b5} { $b configure -state normal $b configure -foreground white } .fc_main configure -cursor "" #puts "Done! File [file tail $_FC(file)] converted to $_FC(packagekeyname)" display_text wm title .fc_main {Eolas GIF-to-Base64 Image Encoder} } #---------- proc fc_loadsave {loadflag} { global fc_loadsave _FC if {![info exists fc_loadsave(pwd)]} { set fc_loadsave(pwd) [pwd] set fc_loadsave(filter) "*.gif" set fc_loadsave(file) "" } set fc_loadsave(loadflag) $loadflag set fc_loadsave(path) "" set fc_loadsave(done) 0 #- TOP LEVEL ----------------------------------------- toplevel .fc_loadsave -background LightGray wm withdraw .fc_loadsave wm title .fc_loadsave "Load File" wm geometry .fc_loadsave +[expr \ ([winfo screenwidth .]/2) - 173]+[expr ([winfo screenheight .]/2) - 148] #------------------------------------------ set Parent .fc_loadsave #------------------------------------------ set Name $Parent.dir frame $Name -background lightgray pack $Name -anchor nw -side top #------------------------------------------ set Name $Parent.dir.e3 entry $Name -background aliceblue -foreground black \ -highlightbackground LightGray -width 35 \ -textvariable fc_loadsave(pwd) pack $Name -side right -anchor nw -padx 5 bind $Name{fc_loadsavegetentries} bind $Name { if [%W selection present] { %W delete sel.first sel.last } else { %W delete insert } } #---------- set Name $Parent.dir.l1 label $Name -background LightGray -text "Directory: " pack $Name -side right -anchor nw #------------------------------------------ set Name $Parent.type frame $Name -background lightgray pack $Name -anchor nw -side top -fill x #------------------------------------------ set Name $Parent.type.e7 entry $Name -background aliceblue -foreground black \ -highlightbackground LightGray -width 35 \ -textvariable fc_loadsave(filter) pack $Name -side right -anchor nw -padx 5 bind $Name {fc_loadsavegetentries} bind $Name { if [%W selection present] { %W delete sel.first sel.last } else { %W delete insert } } # #---------- set Name $Parent.type.l5 label $Name -background LightGray -text "File Type: " pack $Name -side right -anchor nw #------------------------------------------ set Name $Parent.file frame $Name -background lightgray pack $Name -anchor nw -side top -fill x #------------------------------------------ set Name $Parent.file.e11 entry $Name -background aliceblue -foreground black \ -highlightbackground LightGray -width 35 \ -textvariable fc_loadsave(file) pack $Name -side right -anchor nw -padx 5 .fc_loadsave.file.e11 delete 0 end .fc_loadsave.file.e11 insert 0 $_FC(packagekeyname) bind $Name { if [%W selection present] { %W delete sel.first sel.last } else { %W delete insert } } bind $Name {if {[fc_loadsavevalentry]} {set fc_loadsave(done) 1}} #------------------------------------------ set Name $Parent.file.l9 label $Name -background LightGray -text "File: " pack $Name -side right -anchor nw #------------------------------------------ set Name $Parent.list frame $Name -background LightGray -borderwidth 2 -height 50 \ -highlightbackground LightGray -relief raised -width 50 pack $Name -side top -anchor nw -expand yes -fill both #------------------------------------------ set Name $Parent.list.lb1 listbox $Name -background aliceblue \ -foreground black \ -highlightbackground LightGray -selectbackground LightBlue \ -selectforeground black \ -yscrollcommand "$Parent.list.sb2 set" -selectmode browse pack $Name -anchor center -expand 1 -fill both -ipadx 0 -ipady 0 \ -padx 2 -pady 2 -side left bind $Name {fc_loadsaveselbegin %W %y} bind $Name {fc_loadsaveselbegin2 %W} bind $Name {fc_loadsaveselbegin %W %y} bind $Name {fc_loadsaveselbegin %W %y} bind $Name {set _FC(packagekeyname) \ $seld_file; fc_loadsaveselend %W %y} bind $Name {break} bind $Name {break} bind $Name {fc_loadsaveselend %W %y} bind $Name { tkCancelRepeat tkListboxBeginSelect %W [%W index active] %W activate [%W index active] } bind $Name { tkCancelRepeat tkListboxBeginSelect %W [%W index active] %W activate [%W index active] } #------------------------------------------ set Name $Parent.list.sb2 scrollbar $Name -activebackground plum -activerelief sunken \ -background LightGray -command "$Parent.list.lb1 yview" \ -highlightbackground LightGray -troughcolor gray40 pack $Name -anchor center -expand 0 -fill y -ipadx 0 -ipady 0 \ -padx 2 -pady 2 -side left #---------- set Name $Parent.buttons frame $Name -background lightgray pack $Name -side top -anchor nw -fill x #------------------------------------------ set Name $Parent.buttons.ok button $Name -activebackground lavender -background gray40 \ -foreground white -highlightbackground LightGray -text OK \ -command {set _FC(packagekeyname) [.fc_loadsave.file.e11 get]; if \ {[fc_loadsavevalentry]} {set fc_loadsave(done) 1}} pack $Name -side left -anchor nw -padx 3 -pady 3 #------------------------------------------ set Name $Parent.buttons.cancel button $Name -activebackground lavender -background gray40 \ -foreground white -highlightbackground LightGray -text Cancel \ -command {destroy .fc_loadsave} pack $Name -side right -anchor nw -padx 3 -pady 3 fc_loadsavegetentries wm deiconify .fc_loadsave vwait fc_loadsave(done) destroy .fc_loadsave if {[file isdirectory $fc_loadsave(path)]} {set fc_loadsave(path) ""} return $fc_loadsave(path) } proc fc_loadsaveselbegin {win ypos} { $win select anchor [$win nearest $ypos] } proc fc_loadsaveselbegin2 {win} { global seld_file set seld_file [$win get [$win curselection]] .fc_loadsave.file.e11 delete 0 end .fc_loadsave.file.e11 insert 0 $seld_file set _FC(packagekeyname) $seld_file } proc fc_loadsaveselend {win ypos} { global fc_loadsave $win select set anchor [$win nearest $ypos] set fil [.fc_loadsave.list.lb1 get [lindex [$win curselection] 0]] if {-1 == [string last "/" $fil]} { set fc_loadsave(file) $fil set fc_loadsave(path) \ [eval file join $fc_loadsave(pwd) $fc_loadsave(file)] set fc_loadsave(done) 1 return "" } set fc_loadsave(pwd) [fc_loadsavemergepaths \ $fc_loadsave(pwd) [string trimright $fil "/"]] fc_loadsavegetentries return "" } proc fc_loadsavegetentries {} { global fc_loadsave tcl_version set e 0 if {![file isdirectory $fc_loadsave(pwd)]} { gui_error "\"$fc_loadsave(pwd)\" is not a valid directory" .fc_loadsave configure -cursor {} set e 1 } .fc_loadsave configure -cursor watch update set sort_mode "-dictionary" if {[info exists tcl_version] == 0 || $tcl_version < 8.0} { set sort_mode "-ascii" } if {$fc_loadsave(filter) == ""} {set fc_loadsave(filter) "*"} set files [lsort $sort_mode "[glob -nocomplain $fc_loadsave(pwd)/.*] \ [glob -nocomplain $fc_loadsave(pwd)/*]"] .fc_loadsave.list.lb1 delete 0 end if {$e} { .fc_loadsave configure -cursor {} update return } set d "./ ../" set fils "" foreach f $files { set ff [file tail $f] if {$ff != "." && $ff != ".."} { if {[file isdirectory $f]} { lappend d "$ff/" } else { if {[string match $fc_loadsave(filter) $ff]} { lappend fils "$ff" } } } } set files "$d $fils" foreach f $files { .fc_loadsave.list.lb1 insert end $f } .fc_loadsave configure -cursor {} update } proc fc_loadsavevalentry {} { global fc_loadsave _FC if {"." != [file dirname $fc_loadsave(file)]} { set path [fc_loadsavemergepaths \ $fc_loadsave(pwd) $fc_loadsave(file)] set fc_loadsave(pwd) [file dirname $path] if {[file extension $path] != ""} { set fc_loadsave(filter) "*[file extension $path]" } else { set fc_loadsave(filter) "*" } set fc_loadsave(file) [file tail $path] fc_loadsavegetentries return 0 } set fil [fc_loadsavemergepaths $fc_loadsave(pwd) $fc_loadsave(file)] if {[string match $fc_loadsave(loadflag) "load"]} { if {(![file exists $fil]) || (![file readable $fil])} { gui_error "\"$fil\" cannot be loaded." set fc_loadsave(path) "" return 0 } else { set fc_loadsave(path) $fil set _FC(file) $fil set fc_loadsave(done) 1 return 1 } } else { set d [file dirname $fil] if {![file writable $d]} { gui_error "\"$d\" directory cannot be written to." set fc_loadsave(path) "" set _FC(file) "" return 0 } if {[file exists $fil] && (![file writable $fil])} { gui_error "\"$file\" cannot be written to." set fc_loadsave(path) "" set _FC(file) "" return 0 } set fc_loadsave(path) $fil set fc_loadsave(done) 1 set _FC(file) $fil return 1 } } proc fc_loadsavemergepaths {patha pathb} { set pa [file split $patha] set pb [file split $pathb] if {[string first ":" [lindex $pb 0]] != -1} {return [eval file join $pb]} if {[lindex $pb 0] == "/"} {return [eval file join $pb]} set i [expr [llength $pa] - 1] foreach item $pb { if {$item == ".."} { incr i -1 set pa [lrange $pa 0 $i] } elseif {$item == "."} { # -- do nothing } else { lappend pa $item } } return [eval file join $pa] } proc gui_error {message} { catch "destroy .xxx" bell tk_dialog .xxx "Error" "$message" warning 0 Close } if {[info procs bgerror] == ""} { proc bgerror {{message ""}} { global errorInfo puts stderr $errorInfo } } proc fc_error {message} { bell bell after 100 { grab -global .xxx } tk_dialog .xxx "File Convert - Alert!" "$message" warning 0 Close grab release .xxx } proc fc_wait_if_blocked {} { global _FC # -- disable this feature set _FC(blockflag) 0 return set i 0 while {$_FC(blockflag)} { incr i # -- allow a maximum of 10 seconds of blockage if {$i > 20} { set _FC(blockflag) 0 return } after 500 } } wm iconify . toplevel .fc_main -background lightgray wm title .fc_main {Eolas GIF-to-Base64 Image Encoder} wm withdraw .fc_main wm geometry .fc_main +[winfo screenwidth .]+0 global wd #------------------------------------------ set Parent .fc_main set wd [pwd] set _FC(pwd) [pwd] set _FC(file) "" set _FC(packagekeyname) "" set _FC(blockflag) 0 set _FC(target) "" frame $Parent.f pack $Parent.f -side top -anchor nw -expand 0 -fill x button $Parent.f.b1 -text "Load \& Convert GIF File" -command file_convert -activebackground lavender -background gray40 \ -foreground white -highlightbackground LightGray pack $Parent.f.b1 -side left button $Parent.f.b2 -text "View Image" -command show -activebackground lavender -background gray40 \ -foreground white -highlightbackground LightGray pack $Parent.f.b2 -side left button $Parent.f.b4 -text "Copy to Clipboard" -command copy_clip -activebackground lavender -background gray40 \ -foreground white -highlightbackground LightGray pack $Parent.f.b4 -side left button $Parent.f.b5 -text "Exit" -activebackground lavender -background gray40 \ -foreground white -highlightbackground LightGray -command exit pack $Parent.f.b5 -side right frame $Parent.f3 -borderwidth 3 pack $Parent.f3 -side top -anchor nw -expand 1 -fill both label $Parent.f3.l -text "Data for:" pack $Parent.f3.l -side top -anchor nw -padx 5 scrollbar $Parent.f3.sc -command "$Parent.f3.t yview" -orient vertical pack $Parent.f3.sc -anchor ne -side right -padx 4 -pady 2 -expand 0 -fill y text $Parent.f3.t -borderwidth 3 -background white -height 10 -width 94 -yscrollcommand "$Parent.f3.sc set" pack $Parent.f3.t -side top -expand 1 -fill both wm geometry .fc_main +[expr \ ([winfo screenwidth .]/2) - 125]+[expr ([winfo screenheight .]/2) - 125] wm deiconify .fc_main