home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _e3f82d929cc7af676d98c476b15de02d < prev    next >
Encoding:
Text File  |  2004-06-01  |  1.1 KB  |  40 lines
  1. # This demonstration script prompts the user to select a directory.
  2.  
  3. use vars qw/$TOP/;
  4.  
  5. sub choosedir {
  6.     my $demo = shift;
  7.  
  8.     $TOP = $MW->WidgetDemo
  9.       (
  10.        -name     => $demo,
  11.        -text     => "Enter a directory name in the entry box or click on the \"Browse\" buttons to select a directory name using the directory selection dialog.",
  12.        -title    => 'Choose Directory Demonstration',
  13.        -iconname => 'choosedir',
  14.       );
  15.     {
  16.     my $f = $TOP->Frame;
  17.     my $lab = $f->Label(-text => "Select a directory to open: ",
  18.                 -anchor => 'e');
  19.     my $ent = $f->Entry(-width => 20);
  20.     my $but = $f->Button(-text => "Browse ...",
  21.                  -command => sub { dirDialog($TOP, $ent)});
  22.     $lab->pack(-side => 'left');
  23.     $ent->pack(-side => 'left',-expand => 'yes', -fill => 'x');
  24.     $but->pack(-side => 'left');
  25.     $f->pack(-fill => 'x', -padx => '1c', -pady => 3);
  26.     }
  27. }
  28.  
  29. sub dirDialog {
  30.     my $w = shift;
  31.     my $ent = shift;
  32.     my $dir;
  33.     $dir = $w->chooseDirectory;
  34.     if (defined $dir and $dir ne '') {
  35.     $ent->delete(0, 'end');
  36.     $ent->insert(0, $dir);
  37.     $ent->xview('end');
  38.     }
  39. }
  40.