home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _a07053db20444bdbe63dc5f45085c2c8 < prev    next >
Text File  |  2004-06-01  |  891b  |  31 lines
  1. # photo1.pl
  2.  
  3. use vars qw/$TOP/;
  4.  
  5. sub photo1 {
  6.  
  7.     my($demo) = @_;
  8.  
  9.     $TOP = $MW->WidgetDemo(
  10.         -name             => $demo,
  11.         -text             => 'This demonstration displays, for two seconds, a picture of a teapot over a green background, then proceeeds to render transparent a 50 x 50 pixel area of the teapot so that the green background shows through.',
  12.         -title            => 'Transparent Pixels',
  13.         -iconname         => 'photo1',
  14.     );
  15.  
  16.     my $l = $TOP->Label( qw/ -background green -width 300 -height 300 / )->pack;
  17.  
  18.     my $f1 = $TOP->Photo( -file => Tk->findINC( 'demos/images/teapot.ppm' ) );
  19.     $l->configure( -image => $f1 );
  20.     $TOP->idletasks;
  21.     $TOP->after(2000);
  22.  
  23.     foreach my $x ( 50 .. 100 ) {
  24.     foreach my $y ( 50 .. 100 ) {
  25.         $f1->transparencySet( $x, $y, 1 );
  26.         $f1->update;
  27.     }
  28.     }
  29.  
  30. } # end photo1
  31.