Hello, the following is a wrapper developed in & for [tG²] which is using a dedicated namespace to provide the user the ability to control a .gif animation inside a tk-label widget. Unfortunately, I can not demonstrate it, since the functionality makes use of timers, a dedicated functionality I created specificly for the [tG²] interface long time ago. It makes also use of other custom wrappers, created in other tcl-libraries. To summarize the abilities of this wrapper: 1. detect if .gif image has multiple frames 2. manage a deciated array, such that multiple animations in different label widgets is possible 3. play a .gif 4. pause a .gif 5. repeated play or play once (reverse and other combinations could have been implemented, but I dont feel like at the moment) 6. delete all images specific for that label to free up memory 7. delete all images specific for toplevel to free up memory 8. control animation speed (framerate) 9. etract original animation framerate from file Adding an animated .gif to a tG2-layout is childsplay now, by "dragon drop" & play/pause buttons in the Layout Editor. [tG²] is under heavy (re)construction, release date unknown. ====== # Inspired from : http://wiki.tcl.tk/4882, Richard Suchenwirth & several authors & contributors # Wrapper Created for tG2 integration, copyright (C) 2015 Sedat Serper # License: BSD, retain this header information when distributed. # Usage : ::gifAnim::doAnimation <.gif filename> ?frame speed? # source ./procedures/gifAnimations_1.tcl namespace eval ::gifAnim { set cfg(timers) "" image create photo ::gifAnim::icon -data { iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAFJUlEQVR42sVXa2wUVRT+ZmefM9vd bQstaSsRqUppi6hoJGhpU8UENdE0UX+ABOMfkxpM24Dgq1ijJkCNRjQmGpUQEzVE+FOjRIu1TVsf gBRRUx7a2uj2td3tPmd2dr1n1ll3O7NliwZOc7PTuffO+e53nper2P6OveCWDZ0ANrFRgMsjs2wc DA31tXBVn4y8yf55/GI7rCZg3WIr1rKx0m1GucCjwMKlviYnMRZWcMYfR/+EhD42pEReQN4iAIH5 Tu5iSh65RkDTUjvcDEUymYQsy0gkEuozCcdxMJlMsFgs6rOfaT80EsWB82EE5OS8TBCAnCs2ltvQ ttIJNwMhSZKqmJSSIp7nVWUk9E5RFMhxGRz7o3mr1Qo/U773TBBdY7GcCAwB8Oy7u2qceGCpQ1Ua jUbTHyWlmuK5QkBoaGDtdru679ORCF46HYSSzAMAKd9zkwv1S2yIRCIq1Q6HY17FRkBoHwEn09D+ 7r9i2H48oAOhA/BsberkoVBI3UynyFexEZBYLKaaRxRFlYmOoWBuAGTzF1e71JOT/BflmSCICRJi 4pmTgSyfSAMgbz9cXwSRUxCTYhAFMUt5rzeKtYss6B6XUb/YnOWEmqKjYxHcWWbHMW8M60us6hpt LhwOqz4USvK4/9h0OjrSAJqvF7F1uQPBYFCli+jPlOeO+1BskvGtn8PuKjOK3a6s+SgzbsvgFG4r MmE0nEAHY5JOrAmZgUA4nU68dy6CN34N/QuAksznjcWwJ1NhZrPZdNTv/8mHzVfx6DyXgE0Ow27h s+ZjLPHMSgp21rqwfziKJ1YIEByCzh/ou1HOgru/nFKTlQqgodSKfWvc6ukFQdCdXmOgkJNwIsCh s9oEt9utM8GW3mnc6gFGmQt1rC5Qv5UpxAL5F7HQ+r0f3V4pBYBinjIdAaBJI8d77bQPTWVmvPu7 gm3LYAjg6cFxNK8Q8f75KJ6symZAW6PpoExJuUEFcHCdB5VCKnbJ843khRM+lPMx9PtN2FNjgcfj 0QHY2jOOuiLgl2AS7Te4dAyovvJPbjgb5rCpbyYFoPuuYtgSkuq1lLmMZO8pHxpLeHw8pmDHcs6Q gdb+cWypFHFkNMpSuJ4BEsqQZIqYyYqGo1MpAD9sXJROt2az2RDAyz/6UG2X0DVpwr1LTCgscOqi 4KPhGdzH5gZ8zBy1BYYMxOPxdJq+uWtyYQDWFPI48qeCejEMwWZRC08aQCKJz7wJPLhMRA/LA09V GzNgCCBfE9zuknHIy2HntbzqA3MdrG1gAg9X8OhiQHbUGDNgaIK8nPCkD5WiCT2TCl6pMg7DR7+Z wAaWCU9Nx1hNEQ0ZMHTCdBiGWIiIOcJwyId7imV8MMahpdJsGAW7Brx47GoeH/6RQGu1noGcYZhP InqehWGZncPgdAL7qjl43HoAm7+eQB0r42f9EtpX6RnImYjyTcUPlSp4/TcWgsxNXEK2qSgKvDOz aLnOhrcvxLGtypnFgFYV6XC6VEwLMosRbdQqmSaUikutSTXE2iqiOgBUC9p/llFXasOFWRm7V2UD mLcY0UNmOaaWijZnsvDVaAA3OhX0+jjcUZRKxXPl8PAkGkos6J1S0FgmpKthXuWYJLMhIeWZpqAI yaSTqJzrA7SG3tOv1inn3ZBo8n+3ZKScAOXVkpEYNaUEYu6JL6b4kptSDYRRW05jPiCaYvIhSrmX 1JZnyoIvJmye3i30YkIXRWeuBZfjanZlL6dlza/a3eubrsj1fPa7L1r+BkExdRnjBgJiAAAAAElF TkSuQmCC} # --- # Purpose : extracts and returns list of all image references from given .gif file # Source : http://wiki.tcl.tk/4882 # --- proc ::gifAnim::getImages {file} { set i 0 set res {} while 1 { if [catch {image create photo -file $file -format "gif -index $i"} msg] {return $res} lappend res $msg incr i } } # --- # Purpose : cycles the list of images in forward motion, faster than tcl2_ListScroll? # Source : http://wiki.tcl.tk/4882 # --- proc ::gifAnim::lcycle {listName} { upvar 1 $listName list set res [lindex $list 0] set list [concat [lrange $list 1 end] [list $res]] set res } # --- # Purpose : set a different framerate or completely clear & free assigned timer # --- proc ::gifAnim::animationSpeed {w speed {clear 0}} { variable cfg set i $cfg(${w},timer) if {$clear && ($speed==0)} { $w config -image [lindex $::gifAnim::animImages($i) 0]; set ::timer${i}_delay 0; set ::timer${i}_cmd "" } { switch $cfg(${w},mode) { "once" {set cmd "if {\"[lindex $cfg(${w},images) 0]\"==\"\[lindex \$::gifAnim::animImages($i) 0]\"} {set ::timer${i}_delay 0}"} default {set cmd ""} } set ::timer${i}_cnt 0 set ::timer${i}_delay $speed if {$speed>0} {set cfg(${w},speed) $speed} set ::timer${i}_cmd " if {\[catch {eval {$w configure -image \[::gifAnim::lcycle ::gifAnim::animImages($i)]}}] || (\[llength \$::gifAnim::animImages($i)]==1)} \{ set ::timer${i}_cmd \"\"; set ::timer${i}_delay 0; ::gifAnim::delImages $w \} $cmd " } } proc ::gifAnim::delImages {w {exception ""}} { variable cfg set i $cfg(${w},timer) foreach j $::gifAnim::animImages($i) {if {$j!=$exception} {image delete $j}} if {$exception==""} {unset ::gifAnim::animImages($i); set cfg($w,file) ""} {set ::gifAnim::animImages($i) [lindex $::gifAnim::animImages($i) 0]} } # --- # Purpose : use this to delete frame images in case animation was stopped before toplevel deletion # --- proc ::gifAnim::delImagesTop {win} { variable cfg set w [winfo toplevel $win] set t 0 foreach j $cfg($w) {if {![catch {image delete $j}]} {incr t}} unset cfg($w) return $t } # --- # Purpose : same as ::gifAnim::killAnimation4, including first image # --- proc ::gifAnim::destroy {w} {::gifAnim::killAnimation4 $w; ::gifAnim::delImages $w} # --- # Purpose : stops animation and deletes all, but first, images. # --- proc ::gifAnim::killAnimation4 {w} { variable cfg set i $cfg(${w},timer) set ::gifAnim::animImages($i) [lsort $::gifAnim::animImages($i)] ::gifAnim::animationSpeed $w 0 1 ::gifAnim::delImages $w [lindex $::gifAnim::animImages($i) 0] } # --- # Purpose : finds a free timer slot # --- proc ::gifAnim::nFTmr {} { set i 1 while {$i<=$::maxTimers} { eval "if {\$::timer${i}_cmd==\"\"} {return \$i}" incr i } return 0 } # --- # Purpose : Tests and return if a given .gif file is an animated file # Usage : ::gifAnim::isAnimatedGif <.gif formatted file> # --- proc ::gifAnim::isAnimatedGif {file} { set t [::gifAnim::getImages $file] if {[llength $t]==1} {set res 0} {set res [llength $t]} foreach i $t {image delete $i} return $res } # --- # Purpose : Check the frame rate as defined in the file # Usage : ::gifAnim::getGifFrameRate <.gif formatted file> # Output : returned value * 10ms is frame rate # --- proc ::gifAnim::getGifFrameRate {file} { set d 0 set i 0 set f [open $file r] fconfigure $f -translation binary while {$i<1000} { binary scan [read $f 2] s B1 if {$B1=="-1759"} { binary scan [read $f 2] s B1 binary scan [read $f 2] s d break } incr i } close $f return $d } # --- # Purpose : wrapper for layout editor to place a label with animated .gif file # --- proc ::gifAnim::place_gifLabelAnimation {tParent file x y {speed 5} {timer 0} {bg SystemButtonFace} {mode repeat} {packed ""}} { if {$tParent=="."} {set tParent ""} set w $tParent.anigif[getUniqueWidgetIndex] if {$packed==""} {place [label $w -bg $bg] -x $x -y $y} {eval "pack [label $w] $packed"} if {[file dirname $file]=="."} {set file "$::dev_folder/pictures/$file"} if {($file=="") || ![file exists $file] || [file isdirectory $file]} {$w config -image ::gifAnim::icon} {::gifAnim::doAnimation $w $file $speed $timer $mode} return $w } # --- # Purpose : a label with animated .gif can be paused with this proc # --- proc ::gifAnim::pauseAnim {w} { variable cfg set i $cfg(${w},timer) $w configure -image [::gifAnim::lcycle ::gifAnim::animImages($i)] ::gifAnim::animationSpeed $w 0 } # --- # Purpose : a label with animated .gif can be (resumed to) play with this proc # --- proc ::gifAnim::playAnim {w} { variable cfg ::gifAnim::animationSpeed $w $cfg(${w},speed) } # --- # Purpose : in case user wants to implement a similar function by script # --- proc ::gifAnim::doAnimation {w afile {speed 5} {timer 0} {mode repeat}} { variable cfg if {[string trim $afile]!=""} { if {[file dirname $afile]=="."} { if {[catch {set afile "[$::targetFolder get]/pictures/$afile"}]} {set afile "$::dev_folder/pictures/$afile"} } if {![file exists $afile]} { mBox "Image file does not exist...\n$afile" "File not found" "error" ok return 0 } } {return 0} if {$timer==0} {set i [::gifAnim::nFTmr]} {set i $timer} if {$i>0} { set cfg(${w},timer) $i set cfg(${w},speed) $speed set cfg(${w},mode) $mode set cfg(${w},file) $afile set ::gifAnim::animImages($i) [::gifAnim::getImages $afile] set cfg(${w},images) $::gifAnim::animImages($i) ::gifAnim::animationSpeed $w $speed if {![info exists cfg([winfo toplevel $w])]} {set cfg([winfo toplevel $w]) ""} set cfg([winfo toplevel $w]) [luniq "$cfg([winfo toplevel $w])$::gifAnim::animImages($i) "] return $i } { mBox "Unable to allocate a free timer\nUnable to run gif animation...\nPlease increase ::maxTimers." "No free timer" "warning" ok } return 0 } } ====== <>Enter Category Here