Version 0 of Create starkit.ico for windows starpack

Updated 2008-04-14 21:00:05 by UKo

This wiki is a great source for nearly everything tcl related. And sometimes the gems found need a little polish. On the page windows icons CF has provided the missing link for creating full blown icon files for the amazing tclkit based starpacks. Unfortunately this script doesn't run out of the box with a minimal tcl installation or a starkit. So her comes slightly enhanced standalone version from UKo that uses the tklib ico-package.

Prerequisites:

  • convert from ImageMagick
  • the ico-package either in the current directory, a lib-subdirectory or just installed

Save the code to a file CreateWinIcon.tcl and call it like this

tclkit CreateWinIco.tcl img48.gif

This gives a wonderful tclkit.ico with all necessary sizes and color depths.

#! /usr/bin/env wish

package require Tk

lappend auto_path "." "lib"
package require ico

# the original graphics file must be a GIF with dimen 48x48
# (PNG doesn't work, for tk doesn't know about it)
set orig [lindex $argv end]
set icoFile tclkit.ico

image create photo temp48 -file $orig
::ico::writeIcon $icoFile 0 8 temp48

if {[image width temp48] != 48 || [image width temp48] != 48} {
  puts stderr "'$orig' is not an 48x48 image file"
  exit
}

pack [label .i -image temp48]
pack [label .l -textvariable state -width 18]

set pos -1
foreach s {48 32 16} {
  set name [format "temp%s" $s]
  set geom [format %dx%d $s $s]
  set state "$geom @ 256"; update idle;

  exec convert -geometry $geom -colors 256 $orig $name.gif
  image create photo $name -file $name.gif
  ::ico::writeIcon $icoFile [incr pos] 8 $name

  set state "$geom @ 16"; update idle;
  exec convert -geometry $geom -colors 16 $orig r$name.gif
  image create photo r$name -file r$name.gif
  ::ico::writeIcon $icoFile [incr pos] 4 r$name
  file delete $name.gif r$name.gif
}

set state "DONE\nIcon file is $icoFile"
pack [button .b -text "EXIT" -command exit]