Image Conversion Tool

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