use strict;
use Tk;
use Tk::Animation;

my $scale;
my $haupt = new MainWindow;
my $img = $haupt->Animation('-format' => 'gif', -file => 'icons/sc_7.gif');
my $label = $haupt->Label(-image=>$img)->pack;
$img->blank(1);

$scale = $haupt->Scale(-from => 0, -to => $#{$img->{'_frames_'}}, -orient => "horizontal", -command =>sub { $img->set_image( $scale->get ); } )->pack();

MainLoop();

use strict;
use Tk;

my $scale;
my $haupt = new MainWindow;
my @img;
for my $i (0 .. 1000) {
    my $img;
    eval {
        $img = $haupt->Photo(-file => "anim.gif", -format=> "gif -index $i");
    };
    if (!$@) {
        push @img, $img;
    } else {
        last;
    }
}

my $img_i = 0;
my $label = $haupt->Label(-image=>$img[$img_i])->pack;
$label->repeat(100, sub {
               
    $img_i++;
               
    if ($img_i > $#img) { $img_i = 0 }
               
    $label->configure(-image => $img[$img_i]);
               });
               
    

MainLoop();

$obj->copy($frames->[$index]);

$obj->put($frames->[$index]->data(-background => "#dddddd"))

#!/usr/bin/perl

use strict;
use warnings;
use Tk;
use Tk::Animation;
use Tk::Photo;

my $scale;
my $haupt = new MainWindow;
my $img = $haupt->Animation('-format' => 'gif', -file => './icons/archiv.gif');
my $image = $haupt->Photo('-format' => 'gif', -file => './icons/top.gif');
my $image2 = $haupt->Photo('-format' => 'gif', -file => './icons/edit.gif');
$img->add_frame($image);
$img->add_frame($image2);
my $label = $haupt->Label(-image=>$img)->pack;
$img->add_label($label);
$img->blank(1);

$scale = $haupt->Scale(-from => 0, -to => $#{$img->{'_frames_'}}, 
                             -orient => "horizontal", 
                             -command =>sub { $img->set_image( $scale->get ); } )->pack();

MainLoop();

sub new{
   my ($class,$widget,%args) = @_;
   my $obj = $class->SUPER::new($widget,%args);
   $obj->{'_MainWIndow_'} = $widget->MainWindow;
   if ($args{'-format'} eq 'gif'){
     my @images;
     $obj->add_frame($class->SUPER::new($widget,%args));
   }
   $obj->set_image( 0 );
   $obj->{_delta_} = 1;
   $obj->{_blank_} = 0;
   return $obj;
}

sub set_image{
   my ($obj,$index)  = @_;
   my $frames = $obj->{'_frames_'};
   return unless $frames && scalar(@$frames)>0;
   $obj->clear_label();
   $index = 0 unless $index < @$frames;
   $obj->blank if $obj->{_blank_};  # helps some make others worse
   $obj->copy($frames->[$index]);
   $obj->{label}->configure(-image => $frames->[$index]) if(defined $obj->{label});
   $obj->{'_frame_index_'} = $index;
}

sub add_label{
   my ($obj,$label) = @_;
   $obj->{label} = $label if defined $label;
}

sub clear_label{
   my ($obj) = @_;
   if(defined $obj->{label}){
     $obj->{label}->configure(-image => '');
   }
}

Data::Dumper->new([$img->{_frames_}],[qw()])->Indent(1)->Useqq(1)->Dump

$VAR1 = [
  bless( {}, 'Tk::Animation' ),
  bless( {}, 'Tk::Animation' ),
  bless( {}, 'Tk::Animation' ),
  bless( {}, 'Tk::Animation' ),
  bless( {}, 'Tk::Animation' ),
  bless( {}, 'Tk::Animation' ),
  bless( {}, 'Tk::Animation' ),
  bless( {}, 'Tk::Animation' )
];