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