Tk Source Code

Artifact 4bb66259d67ac3b3026454cfeed9824cc2e6bde3292aa0fd42a39def020b17c6:

Attachment "GetNumImgs.tcl" to ticket [865af0148c] added by obermeier 2024-06-13 18:59:41.

---

set tkVersion [package require Tk]
puts "Tk : $tkVersion ([expr 8 * $tcl_platform(pointerSize)]-bit)"

if { 0 } {
    set imgVersion [package require img::gif]
    puts "Img: $imgVersion"
}

set f "e34116d68f49c7852b362ec72a636df5.gif"

proc CheckIndex { fileName fmt ind } {
    puts "Checking index $ind"
    set retVal [catch {image create photo -file $fileName -format "$fmt -index $ind"} phImg]
    if { $retVal == 0 } {
        image delete $phImg
        return true
    }
    return false
}

proc GetNumImgs { fileName fmt inc } {
    if { [CheckIndex $fileName $fmt 1] } {
        set ind $inc
        while { [CheckIndex $fileName $fmt $ind] } {
            incr ind $inc
        }
        incr ind -1
        while { ! [CheckIndex $fileName $fmt $ind] } {
            incr ind -1
        }
        return [expr { $ind + 1 }]
    }
    return -1
}

set retVal [catch {set phImg [image create photo -file $f]} err]
if { $retVal == 0 } {
    puts "$f -> $phImg ([image width $phImg] x [image height $phImg])"
    label .l -image $phImg
    pack .l
} else {
    puts "Error: $err"
}

set numImgs [GetNumImgs $f "GIF" 5]
puts "numImgs: $numImgs"

bind . <Escape> exit