Tcl Library Source Code

Artifact 16f4de992c66f56a477efa36b89c025aa460d95d:

Attachment "\tklibIcoTest.tk" to ticket [d8d201739e] added by anonymous 2013-12-04 08:46:57. (unpublished)

---

package require ico;
package require img::ico;

set script [info script];
if {$script eq ""} {
    set script $argv0;
}

set fileName [file join [lindex $argv 0]];
set fileName {D:\Development\PlantSimulation\Trunk\PLANT\Application\res\ribbon\icons\ID_RIBBON_CUT.ico};

if {[file extension $fileName] ni {.ico .ICO}} {
    puts stderr "wrong # args: should be \"[info script] icoFileName"
}

proc writeData {fd data} {
    puts -nonewline $fd "            ";
    for {set i 0} {$i < 32} {incr i} {
        puts -nonewline $fd [format "% 8d" $i];
    }

    puts $fd "";

    set i 0;

    foreach row $data {
        puts $fd [format "        % 3d: %s" $i [lmap col $row {expr {$col eq {} ? {     } : $col}}]];

        incr i;
    }
}

set outputDir [file join [file dirname $fileName] [file rootname [file tail $fileName]]];

file mkdir $outputDir;

foreach nameOrID [ico::icons $fileName] {
    foreach member [ico::iconMembers $fileName $nameOrID] {
        lassign $member name width height bpp;

        if {$bpp == 32 && $width == 32 && $height == 32} {
            set data    [ico::getIconByName $fileName [lindex $member 0] -format data];
            ico::getIconByName $fileName [lindex $member 0] -format image -image tklibIcoImage;

            set pngFileName [file join $outputDir [file rootname [file tail $fileName]]_tklib-ico.png];

            tklibIcoImage write $pngFileName -format png;

            image create photo imgIcoImage -file $fileName -format [list ico -index $name];

            if {[catch {image create photo tklibIcoImage2 -data $data;} reason options] == 1} {
                set txtFileName [file join $outputDir [file rootname [file tail $fileName]].txt];

                set fd [open $txtFileName w];
                fconfigure $fd -encoding utf-8;

                puts $fd [string repeat "-" 80];
                puts $fd "[clock format [clock seconds]] - \"$script\" - [file tail [info nameofexecutable]] v[info patchlevel]";
                puts $fd [string repeat "-" 80];
                puts $fd "package tklib::ico v[package present ico]"
                puts $fd "package img::ico   v[package present img::ico]"
                puts $fd [string repeat "-" 80];
                puts $fd "couldn't create photo from data provided by the tklib::ico package:";
                puts $fd "    - read ICO file with tklib::ico:                               \"$fileName\"";
                puts $fd "    - written PNG file via \"ico::getIconByName ... -format image\": \"$pngFileName\"";
                puts $fd "    - data from tklib::ico via \"ico::getIconByName ... -format data\" for image creation:"

                writeData $fd $data;

                puts $fd [string repeat "-" 80];
                puts $fd "error message: \"$reason\"";
                puts $fd "catch options dictionary:";

                dict for {key value} $options {
                    puts $fd "    - ${key}: \"$value\""
                }

                puts $fd [string repeat "-" 80];
                puts $fd "data read using the package img::ico and its ICO format handler:";

                writeData $fd [imgIcoImage data];

                close $fd;
            }

            imgIcoImage write [file join $outputDir [file rootname [file tail $fileName]]_img-ico.png] -format png;
        }
    }
}

exit;