home *** CD-ROM | disk | FTP | other *** search
/ Australian Personal Computer 2004 July / APC0407D2.iso / workshop / apache / files / ActivePerl-5.6.1.638-MSWin32-x86.msi / _89281b2902a28d83bc2662f557128974 < prev    next >
Encoding:
Text File  |  2004-04-13  |  1.7 KB  |  60 lines
  1. #
  2. # Labeled frame. Derives from Tk::Frame, but intercepts the labeling
  3. # part.
  4.  
  5. package Tk::LabFrame;
  6.  
  7. use vars qw($VERSION);
  8. $VERSION = '3.021'; # $Id: //depot/Tk8/Tixish/LabFrame.pm#21 $
  9.  
  10. use Tk;
  11. require Tk::Frame;
  12.  
  13. use strict;
  14. use base qw(Tk::Frame);
  15. Construct Tk::Widget 'LabFrame';
  16.  
  17.  
  18. sub Populate {
  19.     my ($cw, $args) = @_;
  20.     my $f;
  21.     my $label;
  22.     my $lside = exists $args->{-labelside} ?
  23.     delete $args->{-labelside} : 'top';
  24.     my $ltext = delete $args->{-label};
  25.     $cw->SUPER::Populate($args);
  26.  
  27.     if ($lside =~ /acrosstop/) {
  28.     my $border = $cw->Frame(-relief => 'groove', -bd => 2);
  29.         $cw->Advertise('border' => $border);
  30.     my $pad = $border->Frame;
  31.     $f = $border->Frame;
  32.     $label = $cw->Label(-text => $ltext);
  33.     my $y = int($label->winfo('reqheight')) / 2;
  34.     my $ph = $y - int($border->cget(-bd));
  35.     if ($ph < 0) {
  36.         $ph = 0;
  37.     }
  38.     $label->form(-top => 0, -left => 4, -padx => 6, -pady => 2);
  39.         # $label->place('-y' => 2, '-x' => 10);
  40.     $border->form(-top => $y, -bottom => -1, -left => 0, -right => -1, -padx => 2, -pady => 2);
  41.     $pad->form(-left => 0, -right => -1, -top => 0, -bottom => $ph);
  42.     $f->form(-top => $pad, -bottom => -1, -left => 0, -right => -1);
  43.     # $cw->Delegates('pack' => $cw);
  44.     } else {
  45.     $f = $cw->Frame(-relief => 'groove', -bd => 2, %{$args});
  46.     $label = $cw->Label(-text => $ltext);
  47.     $label->pack(-side => $lside);
  48.     $f->pack(-side => $lside, -fill => 'both', -expand => 1);
  49.     }
  50.     $cw->Advertise('frame' => $f);
  51.     $cw->Advertise('label' => $label);
  52.     $cw->Delegates(DEFAULT => $f);
  53.     $cw->ConfigSpecs(-labelside => ['PASSIVE', 'labelSide', 'LabelSide', 'acrosstop'],
  54.              'DEFAULT' => [$f]);
  55. }
  56.  
  57. 1;
  58.  
  59. __END__
  60.