home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _1df9bd3a77bf8d6a55a71a7fb54a4576 < prev    next >
Encoding:
Text File  |  2004-06-01  |  3.4 KB  |  105 lines
  1. # image2.pl
  2.  
  3. use File::Basename;
  4. use subs qw/image2_load_dir image2_load_image/;
  5. use vars qw/$TOP/;
  6.  
  7. sub image2 {
  8.  
  9.     # This demonstration script creates a simple collection of widgets
  10.     # that allow you to select and view images in a Tk label.
  11.  
  12.     my($demo) = @_;
  13.     $TOP = $MW->WidgetDemo(
  14.         -name     => $demo,
  15.         -text     => 'This demonstration allows you to view images using a Tk "photo" image.  First type a directory name in the listbox, then type Return to load the directory into the listbox.  Then double-click on a file name in the listbox to see that image.',
  16.         -title    => 'Image Demonstration #2',
  17.         -iconname => 'image2',
  18.     );
  19.  
  20.     my $dir_label = $TOP->Label(-text => 'Directory:');
  21.     my $demo_img = Tk->findINC('demos/images');
  22.     my $dir_name = $TOP->Entry(-width => 30, -textvariable => \$demo_img);
  23.     my $frog0 = $TOP->Frame;
  24.     my $frog = $frog0->Frame;
  25.     my $file_label = $frog->Label(-text => 'File:');
  26.     my $f = $frog->Frame;
  27.     my(@pl) = qw/-side top -anchor w/;
  28.     $dir_label->pack(@pl);
  29.     $dir_name->pack(@pl);
  30.  
  31.     # All these "frog" and "toad" frames are just to repackage the listbox
  32.     # and image side by side so they fit within an SVGA screen.
  33.  
  34.     $frog0->pack;
  35.     $frog->pack(qw/-side left/);
  36.     my $toad = $frog0->Frame;
  37.     $toad->pack(qw/-side right/);
  38.     $file_label->pack(@pl);
  39.     $f->pack(@pl);
  40.  
  41.     my $f_list = $f->Listbox(-width => 20, -height => 10);
  42.     $dir_name->bind('<Return>' => [\&image2_load_dir, $f_list, \$demo_img]);
  43.     my $f_scroll = $f->Scrollbar(-command => [$f_list => 'yview']);
  44.     $f_list->configure(-yscrollcommand => [$f_scroll => 'set']);
  45.     @pl = qw/-side left -fill y -expand 1/;
  46.     $f_list->pack(@pl);
  47.     $f_scroll->pack(@pl);
  48.     $f_list->insert(0, qw(earth.gif earthris.gif mickey.gif teapot.ppm));
  49.  
  50.     my $image2a = $TOP->Photo;
  51.     $f_list->bind('<Double-1>' => [\&image2_load_image, $image2a, \$demo_img]);
  52.     my $image_label = $toad->Label(-text => 'Image:');
  53.     my $image = $toad->Label(-image => $image2a);
  54.     @pl = qw/-side top -anchor w/;
  55.     $image_label->pack(@pl);
  56.     $image->pack(@pl);
  57.  
  58. } # end image2
  59.  
  60. sub image2_load_dir {
  61.  
  62.     # This procedure reloads the directory listbox from the directory
  63.     # named in the demo's entry.
  64.     #
  65.     # Arguments:
  66.     # e       -                 Reference to entry widget.
  67.     # l       -                 Reference to listbox widget.
  68.     # dir_name -                 Directory name reference.
  69.  
  70.     my($e, $l, $dir_name) = @_;
  71.  
  72.     $l->delete(0, 'end');
  73.     my $i;
  74.     local *DIR;
  75.     opendir DIR, $$dir_name;
  76.     foreach $i (sort readdir DIR) {
  77.        $l->insert('end', $i);
  78.     }
  79.     closedir DIR;
  80.  
  81. } # end image2_load_dir
  82.  
  83. sub image2_load_image {
  84.  
  85.     # Given the name of the toplevel window of the demo and the mouse
  86.     # position, extracts the directory entry under the mouse and loads
  87.     # that file into a photo image for display.
  88.     #
  89.     # Arguments:
  90.     # l       -         Reference to listbox widget.
  91.     # i       -         Reference to image object.
  92.     # dir_name -         Directory name reference.
  93.  
  94.     my($l, $i, $dir_name) = @_;
  95.  
  96.     my $e = $l->XEvent;
  97.     my($x, $y) = ($e->x, $e->y);
  98.     $i->configure(-file => "$$dir_name/" . $l->get("\@$x,$y"));
  99.  
  100.     # NOTE:  $l->get('active') works just as well.
  101.  
  102. } # end image2_load_image
  103.  
  104. 1;
  105.