Webmaster Forum / Perl / Tk / July 2008

Hi all,

I am using Tk 5.8.3, getting problem in drag n drop.
I am creating a tree with optional scroll bar, on each child of this
tree i am creating a frame (colored green in following code), and a
label (colored blue) which is a child of frame.
Now after creating drag n drop bindings for tree & its children drag n
drop is working for each widget.

           But after scrolling, if i drag a a widget n drop on blue
label it is not working.

I did debug DragDrop.pm,
where function sub FindSite { } returning a Null site, so line
$site->Motion($token,$e) if (defined $site)
is not getting executed.

I am attaching following code for more debugging purpose.
Please help me to resolve this problem.
Thanks,
Rahul Dashore

Drag n Drop Sample Code:

use Tk;
use Tk::DropSite;
use Tk::DragDrop;
use Tk::Tree;
my $mw = MainWindow->new(-title => 'Tree');

my $sourceItem;

my $tree = $mw->Scrolled(
       'Tree',
       -scrollbars => 'osoe',
       -column     => 1,
       )->pack(
           -side   => 'top',
           -fill   => 'both',
           -expand => 1
           );

foreach my $val (qw/orange orange.red orange.yellow orange.yellow.lite
orange.yellow.hard green green.blue green.yellow purple purple.red
purple.blue hara hara.lal hara.lal.peela hara.lal.kala/) {

   $tree->add($val);

   my $imageAndTextFrame = $tree->Frame(
           -bg     => 'green',
           )->pack(
               -side => 'left'
               );

   $imageAndTextFrame->bind(
           '<1>'   => sub {
           my $ent = getMousePositionOnTree($tree);
           $tree->selectionSet($ent);
           if($ent ne '')
           {
           $tree->anchorClear();
           $tree->anchorSet($ent);
           $tree->selectionClear();
           $tree->selectionSet($ent);
           }
           });

   my $label = $imageAndTextFrame->Label(
           -text     => $val,
           -bg       => 'blue',
           -fg       => 'red',
           )->pack(
               -side   => 'left',
               );

   $label->bind(
           '<1>'   => sub {
           my $ent = getMousePositionOnTree($tree);
           $tree->selectionSet($ent);
           if($ent ne '')
           {
           $tree->anchorClear();
           $tree->anchorSet($ent);
           $tree->selectionClear();
           $tree->selectionSet($ent);
           }
           });

   $tree->itemCreate(
           $val,
           0,
           -itemtype   => 'window',
           -widget     => $imageAndTextFrame,
           );

   createDragDropBindings($imageAndTextFrame);
   createDragDropBindings($label);

}
createDragDropBindings($tree);

$tree->autosetmode( );
MainLoop;

sub set_sourceItem {
   $sourceItem = $tree->infoAnchor();
   return;
}

sub dropItemOpr {

   my $destinationItem = getMousePositionOnTree($tree);
   print "sourceItem = $sourceItem ---- destinationItem =
$destinationItem\n";
}

sub getMousePositionOnTree {

   my $treeHandle = shift;

   my ($X,$Y) = ($Tk::event->X,$Tk::event->Y);
   my $rooty = $treeHandle->rooty;
   my $y = $Y - $rooty;
   my $ent = $treeHandle->GetNearest($y,1);

   return ($ent);
}

sub createDragDropBindings {

   my $widget = shift;

   $widget->DragDrop(
           -event          => '<B1-Motion>',
           -text           => "DND",
           -sitetypes      => ['Local'],
           -startcommand   => sub {
           set_sourceItem();
           },
           );

   $widget->DropSite(
           -droptypes      => ['Local'],
           -dropcommand    => sub {
           dropItemOpr();
           } ,
           );
}