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 [Starpack]s. 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, Anyone know why?


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]
======

<<categories>>Gui