home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _ab3c3a653993cd99ce41a445369b81c8 < prev    next >
Text File  |  2004-06-01  |  2KB  |  71 lines
  1. package Tk::Dialog;
  2.  
  3. use vars qw($VERSION);
  4. $VERSION = '4.004'; # $Id: //depot/Tkutf8/Tk/Dialog.pm#4 $
  5.  
  6. # Dialog - a translation of `tk_dialog' from Tcl/Tk to TkPerl (based on
  7. # John Stoffel's idea).
  8. #
  9. # Stephen O. Lidie, Lehigh University Computing Center.  94/12/27
  10. # lusol@Lehigh.EDU
  11.  
  12. # Documentation after __END__
  13.  
  14. use Carp;
  15. use strict;
  16. use base qw(Tk::DialogBox);
  17.  
  18. Construct Tk::Widget 'Dialog';
  19.  
  20. sub Populate
  21. {
  22.  
  23.     # Dialog object constructor.  Uses `new' method from base class
  24.     # to create object container then creates the dialog toplevel.
  25.  
  26.     my($cw, $args) = @_;
  27.  
  28.     $cw->SUPER::Populate($args);
  29.  
  30.     my ($w_bitmap,$w_but,$pad1,$pad2);
  31.  
  32.     # Create the Toplevel window and divide it into top and bottom parts.
  33.  
  34.     my (@pl) = (-side => 'top', -fill => 'both');
  35.  
  36.     ($pad1, $pad2) =
  37.         ([-padx => '3m', -pady => '3m'], [-padx => '3m', -pady => '2m']);
  38.  
  39.  
  40.     $cw->iconname('Dialog');
  41.  
  42.     my $w_top = $cw->Subwidget('top');
  43.  
  44.     # Fill the top part with the bitmap and message.
  45.  
  46.     @pl = (-side => 'left');
  47.  
  48.     $w_bitmap = $w_top->Label(Name => 'bitmap');
  49.     $w_bitmap->pack(@pl, @$pad1);
  50.  
  51.     my $w_msg = $w_top->Label( -wraplength => '3i', -justify    => 'left' );
  52.  
  53.     $w_msg->pack(-side => 'right', -expand => 1, -fill => 'both', @$pad1);
  54.  
  55.     $cw->Advertise(message => $w_msg);
  56.     $cw->Advertise(bitmap  => $w_bitmap );
  57.  
  58.     $cw->ConfigSpecs( -image      => ['bitmap',undef,undef,undef],
  59.                       -bitmap     => ['bitmap',undef,undef,undef],
  60.                       -font       => ['message','font','Font', '-*-Times-Medium-R-Normal--*-180-*-*-*-*-*-*'],
  61.                       DEFAULT     => ['message',undef,undef,undef]
  62.                      );
  63. }
  64.  
  65. 1;
  66.  
  67. __END__
  68.  
  69. =cut
  70.  
  71.