home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _55e703612c25aa8aa4ff6e213543ce65 < prev    next >
Encoding:
Text File  |  2004-06-01  |  1.0 KB  |  62 lines
  1. package Tk::DragDrop::Local;
  2. use strict;
  3. use vars qw($VERSION);
  4. $VERSION = '4.004'; # $Id: //depot/Tkutf8/DragDrop/DragDrop/LocalDrop.pm#4 $
  5.  
  6. use base qw(Tk::DragDrop::Rect);
  7. require Tk::DragDrop;
  8.  
  9. my @toplevels;
  10.  
  11. Tk::DragDrop->Type('Local');
  12.  
  13. sub XY
  14. {
  15.  my ($site,$event) = @_;
  16.  return ($event->X - $site->X,$event->Y - $site->Y);
  17. }
  18.  
  19. sub Apply
  20. {
  21.  my $site = shift;
  22.  my $name = shift;
  23.  my $cb   = $site->{$name};
  24.  if ($cb)
  25.   {
  26.    my $event = shift;
  27.    $cb->Call(@_,$site->XY($event));
  28.   }
  29. }
  30.  
  31. sub Drop
  32. {
  33.  my ($site,$token,$seln,$event) = @_;
  34.  $site->Apply(-dropcommand => $event, $seln);
  35.  $site->Apply(-entercommand => $event, 0);
  36.  $token->Done;
  37. }
  38.  
  39. sub Enter
  40. {
  41.  my ($site,$token,$event) = @_;
  42.  $token->AcceptDrop;
  43.  $site->Apply(-entercommand => $event, 1);
  44. }
  45.  
  46. sub Leave
  47. {
  48.  my ($site,$token,$event) = @_;
  49.  $token->RejectDrop;
  50.  $site->Apply(-entercommand => $event, 0);
  51. }
  52.  
  53. sub Motion
  54. {
  55.  my ($site,$token,$event) = @_;
  56.  $site->Apply(-motioncommand => $event);
  57. }
  58.  
  59. 1;
  60.  
  61. __END__
  62.