home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _f003cde30874cf0dd5ebb005a7dc1012 < prev    next >
Encoding:
Text File  |  2004-06-01  |  1.5 KB  |  75 lines
  1. # Copyright (c) 1995-2003 Nick Ing-Simmons. All rights reserved.
  2. # This program is free software; you can redistribute it and/or
  3. # modify it under the same terms as Perl itself.
  4. package Tk::Image;
  5.  
  6. # This module does for images what Tk::Widget does for widgets:
  7. # provides a base class for them to inherit from.
  8. require DynaLoader;
  9.  
  10. use base qw(DynaLoader Tk); # but are they ?
  11.  
  12. use vars qw($VERSION);
  13. $VERSION = '4.011'; # $Id: //depot/Tkutf8/Tk/Image.pm#11 $
  14.  
  15. sub new
  16. {
  17.  my $package = shift;
  18.  my $widget  = shift;
  19.  $package->InitClass($widget);
  20.  my $leaf = $package->Tk_image;
  21.  my $obj = $widget->Tk::image('create',$leaf,@_);
  22.  $obj = $widget->_object($obj) unless (ref $obj);
  23.  return bless $obj,$package;
  24. }
  25.  
  26. sub Install
  27. {
  28.  # Dynamically loaded image types can install standard images here
  29.  my ($class,$mw) = @_;
  30. }
  31.  
  32. sub ClassInit
  33. {
  34.  # Carry out class bindings (or whatever)
  35.  my ($package,$mw) = @_;
  36.  return $package;
  37. }
  38.  
  39. require Tk::Submethods;
  40.  
  41. Direct Tk::Submethods ('image' => [qw(delete width height type)]);
  42.  
  43. sub Tk::Widget::imageNames
  44. {
  45.  my $w = shift;
  46.  $w->image('names',@_);
  47. }
  48.  
  49. sub Tk::Widget::imageTypes
  50. {
  51.  my $w = shift;
  52.  map("\u$_",$w->image('types',@_));
  53. }
  54.  
  55. sub Construct
  56. {
  57.  my ($base,$name) = @_;
  58.  my $class = (caller(0))[0];
  59.  
  60.  # Hack for broken ->isa in perl5.6.0
  61.  delete ${"$class\::"}{'::ISA::CACHE::'} if $] == 5.006;
  62.  
  63.  *{"Tk::Widget::$name"}  = sub { $class->new(@_) };
  64. }
  65.  
  66. # This is here to prevent AUTOLOAD trying to find it.
  67. sub DESTROY
  68. {
  69.  my $i = shift;
  70.  # maybe do image delete ???
  71. }
  72.  
  73.  
  74. 1;
  75.