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 / _6da74fb2ab882fcfc6d9ec5c2160ad5c < prev    next >
Encoding:
Text File  |  2004-04-13  |  1.5 KB  |  61 lines
  1. package Tk::Canvas;
  2. use vars qw($VERSION);
  3. $VERSION = '3.018'; # $Id: //depot/Tk8/Canvas/Canvas.pm#18 $
  4.  
  5. use Tk qw($XS_VERSION);
  6.  
  7. use base qw(Tk::Widget);
  8. Construct Tk::Widget 'Canvas';
  9.  
  10. bootstrap Tk::Canvas;
  11.  
  12. sub Tk_cmd { \&Tk::canvas }
  13.  
  14. Tk::Methods('addtag','bbox','bind','canvasx','canvasy','coords','create',
  15.             'dchars','delete','dtag','find','focus','gettags','icursor',
  16.             'index','insert','itemcget','itemconfigure','lower','move',
  17.             'postscript','raise','scale','scan','select','type','xview','yview');
  18.  
  19. use Tk::Submethods ( 'create' => [qw(arc bitmap grid group image line oval
  20.                      polygon rectangle text window)],
  21.              'scan'   => [qw(mark dragto)],
  22.              'select' => [qw(from clear item to)],
  23.              'xview'  => [qw(moveto scroll)],
  24.              'yview'  => [qw(moveto scroll)],
  25.              );
  26.  
  27. *CanvasBind  = \&Tk::bind;
  28. *CanvasFocus = \&Tk::focus;
  29.  
  30. sub ClassInit
  31. {
  32.  my ($class,$mw) = @_;
  33.  $mw->XYscrollBind($class);
  34.  return $class;
  35. }
  36.  
  37. sub BalloonInfo
  38. {
  39.  my ($canvas,$balloon,$X,$Y,@opt) = @_;
  40.  my @tags = ($canvas->find('withtag', 'current'),$canvas->gettags('current'));
  41.  foreach my $opt (@opt)
  42.   {
  43.    my $info = $balloon->GetOption($opt,$canvas);
  44.    if ($opt =~ /^-(statusmsg|balloonmsg)$/ && UNIVERSAL::isa($info,'HASH'))
  45.     {
  46.      $balloon->Subclient($tags[0]);
  47.      foreach my $tag (@tags)
  48.       {
  49.        return $info->{$tag} if exists $info->{$tag};
  50.       }
  51.      return '';
  52.     }
  53.    return $info;
  54.   }
  55. }
  56.  
  57.  
  58.  
  59. 1;
  60.  
  61.