home *** CD-ROM | disk | FTP | other *** search
/ CD Actual Thematic 7: Programming / CDAT7.iso / Share / Editores / Perl5 / perl / lib / site / auto / Tk / Frame / AddScrollbars.al next >
Encoding:
Text File  |  1997-08-10  |  1.4 KB  |  49 lines
  1. # NOTE: Derived from blib\lib\Tk\Frame.pm.  Changes made here will be lost.
  2. package Tk::Frame;
  3.  
  4. sub AddScrollbars
  5. {
  6.  require Tk::Scrollbar;
  7.  my ($cw,$w) = @_;
  8.  my $def = "";
  9.  my ($x,$y) = ('','');
  10.  my $s = 0;
  11.  my $c;
  12.  $cw->freeze_on_map;
  13.  foreach $c ($w->configure)
  14.   {
  15.    my $opt = $c->[0];
  16.    if ($opt eq '-yscrollcommand')
  17.     {
  18.      my $slice  = Tk::Frame->new($cw,Name => 'ysbslice');                                       
  19.      my $ysb    = Tk::Scrollbar->new($slice,-orient => 'vertical', -command => [ 'yview', $w ]);
  20.      my $size   = $ysb->cget('-width');
  21.      my $corner = Tk::Frame->new($slice,Name=>'corner','-relief' => 'raised', 
  22.                   '-width' => $size, '-height' => $size);
  23.      $ysb->pack(-side => 'left', -fill => 'y');
  24.      $cw->Advertise("yscrollbar" => $ysb); 
  25.      $cw->Advertise("corner" => $corner);
  26.      $cw->Advertise("ysbslice" => $slice);
  27.      $corner->{'before'} = $ysb;
  28.      $slice->{'before'} = $w;
  29.      $y = 's';
  30.      $s = 1;
  31.     }
  32.    elsif ($opt eq '-xscrollcommand')
  33.     {
  34.      my $xsb = Tk::Scrollbar->new($cw,-orient => 'horizontal', -command => [ 'xview', $w ]);
  35.      $cw->Advertise("xscrollbar" => $xsb); 
  36.      $xsb->{'before'} = $w;
  37.      $x = 'w';
  38.      $s = 1;
  39.     }
  40.   }
  41.  if ($s)
  42.   {
  43.    $cw->Advertise('scrolled' => $w);
  44.    $cw->ConfigSpecs('-scrollbars' => ['METHOD','scrollbars','Scrollbars',$y.$x]);
  45.   }
  46. }
  47.  
  48. 1;
  49.