--AF 15-07-03

reading windows icons:

 proc IconStats {file} {
    set fh [open $file r]
    fconfigure $fh -encoding binary

    if {"[getword $fh] [getword $fh]" != "0 1"} { error "not an icon file" }
    set num [getword $fh]
    set r {}
    for {set i 0} {$i < $num} {incr i} {
        set info {}
        lappend info [scan [read $fh 1] %c] [scan [read $fh 1] %c]
        set bpp [scan [read $fh 1] %c]
        if {$bpp == 0} {
            set orig [tell $fh]
            seek $fh 9 current
            seek $fh [expr {[getdword $fh] + 14}] start
            lappend info [getword $fh]
            seek $fh $orig start
        } else {
            lappend info [int [expr {sqrt($bpp)}]]
        }
        lappend r $info
        seek $fh 13 current
    }
    close $fh
    return $r
 }

 proc getIcon {file index} {
    set fh [open $file r]
    fconfigure $fh -encoding binary

    if {"[getword $fh] [getword $fh]" != "0 1"} { error "not an icon file" }
    if {$index < 0 || $index >= [getword $fh]} { error "index out of range" }

    seek $fh [expr {(16 * $index) + 12}] current
    seek $fh [getdword $fh] start

    seek $fh 4 current
    set w [getdword $fh]
    set h [expr {[getdword $fh] / 2}]
    seek $fh 2 current
    set bpp [getword $fh]
    seek $fh 24 current

    if {$bpp == 4 || $bpp == 8} {
        set colors [read $fh [int [expr {pow(2, ($bpp + 2))}]]]
    } elseif {$bpp == 24 || $bpp == 32} {
        set colors {}
    } else {
        error "unsupported color depth: $bpp"
    }
    set pad [expr {$w % 32}]
    set xor [read $fh [int [expr {($w * $h) * ($bpp / 8.0)}]]]
    set and [read $fh [expr {(($w * $h) + ($w * $pad)) / 8}]]
    
    close $fh
    
    set palette {}
    foreach {b g r x} [split $colors {}] {
        lappend palette [format #%02X%02X%02X [scan $r %c] [scan $g %c] [scan $b %c]]
    }

    set and2 {}
    set len [expr {[string length $and] - 4}]
    for {set i 0} {$i < $len} {incr i 4} {
        binary scan [string range $and $i [expr {$i + 3}]] B32 tmp
        if {$w == 16 || ($w == 48 && $i % 8 == 4)} {
            set tmp [string range $tmp 0 15]
        }
        append and2 $tmp
    }
    set img [image create photo -width $w -height $h]

    if {$bpp == 4} {
        set x -2
        set y [expr {$h - 1}]
        incr w -2
        foreach s [split $xor {}] {a1 a2} [split $and2 {}] {
            if {$x == $w} { incr y -1; set x 0 } else { incr x 2 }
            binary scan $s B8 tmp
            if {$a1 == "0"} {
                $img put -to $x $y [lindex $palette [bits2int [string range $tmp 0 3]]]
            }
            if {$a2 == "0"} {
               $img put -to [expr {$x + 1}] $y [lindex $palette [bits2int [string range $tmp 4 7]]]
            }
        }
    } elseif {$bpp == 8} {
        set x -1
        set y [expr {$h - 1}]
        incr w -1
        foreach i [split $xor {}] and [split $and2 {}] {
            if {$x == $w} { incr y -1; set x 0 } else { incr x }
            if {$and == "0"} {
                $img put -to $x $y [lindex $palette [scan $i %c]]
            }
        }
    } elseif {$bpp == 24} {
        set x -1
        set y [expr {$h - 1}]
        incr w -1
        foreach {b g r} [split $xor {}] and [split $and2 {}] {
            if {$x == $w} { incr y -1; set x 0 } else { incr x }
            if {$and == "0"} {
                $img put -to $x $y [format #%02X%02X%02X [scan $r %c] [scan $g %c] [scan $b %c]]
            }
        }
    } elseif {$bpp == 32} {
        set x -1
        set y [expr {$h - 1}]
        incr w -1
        foreach {b g r a} [split $xor {}] and [split $and2 {}] {
            if {$x == $w} { incr y -1; set x 0 } else { incr x }
            if {$and == "0"} {
                $img put -to $x $y [format #%02X%02X%02X [scan $r %c] [scan $g %c] [scan $b %c]]
            }
        }
    }
    return $img
 }


 proc int {n} {
    return [lindex [split $n .] 0]
 }

 proc bits2int {bits} {
    set res 0
    foreach i [split $bits {}] {
        set res [expr {$res*2+$i}]
    }
    return $res
 }

 proc getdword {fh} {
    binary scan [read $fh 4] i* tmp
    return $tmp
 }

 proc getword {fh} {
    binary scan [read $fh 2] s* tmp
    return $tmp
 }

----

 Usage:

 IconStats myicons.ico

 Output:
 {16 16 4} {16 16 8} {16 16 32} {32 32 4} {32 32 8} {32 32 32} {48 48 4} {48 48 8} {48 48 32}

a list of values each one being a sublist with 3 elements, width height and color depth


 label .l2$x -image [GetIcon myicons.ico 0]

where 0 is an index of the icon you want to display (see IconStats)

Display all icons in a file:

 set icons [IconStats $argv]
 for {set x 0} {$x < [llength $icons]} {incr x} {
    # catch in case there are any icons with unsupported color
    catch {
        label .l$x -text [lindex $icons $x]
        label .l2$x -image [getIcon $argv $x]
        grid .l$x .l2$x
    }
 }

----

in the coming weeks i should be adding routines to read from .icl .exe and .dll files. as well as writing to all of the above

--AF 17-15-03