Create starkit.ico for windows starpack

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 here comes a slightly enhanced standalone version from UKo that uses the tklib ico-package.

Prerequisites:

convert from Image Magick
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]

jbr - Here is an update to the above code which reads the required icon set from the executable, creates the images and packs them in to the tclkit.ico file. Any image format recognized by ImageMagic convert will do as input. I've run the script on Linux to create the starpack, but not viewed it on Windows yet.

I get a "NOT SAME SIZE" error for all of the 24x24 pixel icons. This is caused by a bug in tklib::ico. I've noted it there and filed a bug report.

Run the script thusly:

  > ./ico.tcl myprog.exe mynewicon.jpg

Code:

#! /usr/bin/env tclkit8.6
#
package require Tk

lappend auto_path . lib /home/john/lib/tklib-0.5/modules
package require ico

set exe [lindex $argv 0]
set img [lindex $argv 1]

set icoFile tclkit.ico

pack [label .l -textvariable state -width 18]

foreach I [::ico::icons $exe] {
    foreach i [::ico::iconMembers $exe $I] {
        lappend icons {*}$i
    }
}

set pos -1
foreach { n x y bpp } $icons {
  set name [format "icon%s" $n]
  set geom [format %dx%d $x $y]
  set state "$geom @ $bpp"; update idle;

  exec convert -geometry $geom -define png:bit-depth=$bpp $img $name.png
  exec convert $name.png $name.gif
  image create photo $name -file $name.gif

  ::ico::writeIcon $icoFile [incr pos] $bpp $name

  pack [label .i$pos -image $name] -side right
  file delete $name.png $name.gif
}

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

jbr - Even more "stand alone" icomaker - tcl only ppm to tclkit.ico converter

Category GUI