Hi Ace128,

I'm not sure exactly what you're trying to do, and I haven't done much with Drag and Drop (more today than ever before!), but here's a suggested rewrite that shows how to drag any of the labels into the Canvas object created in each frame: 

#!/usr/bin/perl -w


use Tk;
use Tk::HList;
use Tk::Pane;
use Tk::DragDrop;
use Tk::DropSite;

use Data::Dumper;

use strict;
use warnings;

my $eyeball = '
    /* XPM */
    static char * eyeball[] = {
    "32 12 4 1",
    "   c None",
    "@  c #000000",
    "x  c #ffffff",
    "o  c #3f3fff",
    "                @@@@@@@@@       ",
    "              @@@@@@@@@@@@@     ",
    "             @@xxxxxxxxxxx@@    ",
    "            @@xxxx@@@@@@xxx@@   ",
    "            @@xxx@@oooo@@xxx@@  ",
    "            @@xx@@oooooo@@xx@@  ",
    "            @@xx@@oooooo@@xx@@  ",
    "            @@xxx@@oooo@@xxx@@  ",
    "             @@xxx@@@@@@xxx@@   ",
    "              @@xxxxxxxxxx@@    ",
    "               @@@@@@@@@@@@     ",
    "                 @@@@@@@@       ",
';



my $mw = MainWindow->new;
my $psym = make_image($mw, $eyeball); 

my $pane = $mw->Scrolled(
                'Pane',
                -width => 800,
                -height => 400,
                -sticky => 'nsew',
                -scrollbars => 'os',
           )->pack(-fill => 'both', -expand => 1);

addCol(1);
addCol(2);
addCol(3);

sub addCol {

    my $id = shift;

    my $width = 200;

    my $frame = $pane->Frame(-relief => "ridge", -bd => 1, -width  => 
+$width);
    $frame->pack(-side => 'left', -fill => 'both', -expand => 1);

    # DnD SUPPORT!

    #my $frame1 = $frame->Frame()->pack();
    #my $frame2 = $frame->Frame()->pack();

    my $adjuster = $pane->Adjuster();
    $adjuster->packAfter($frame, -side => 'left');

    my $label = $frame->Label(-width => 30, -text  => "Test" . $id);
    $label->pack(-fill => "both");

    my $drag = $label->DragDrop(
        -event     => '<B1-Motion>',
        -sitetypes => [qw/Local/],
        -image     => $psym,
    );

    my $can = $frame->Canvas(-bg => 'skyblue')->pack();

    my $drop = $can->DropSite(
        -droptypes    => [qw(Local)],
        -dropcommand  => [\&perform_drop,    $can, $label],
        -entercommand => [\&hover_over_drop, $can],
    );

    my $hlist = $frame->Scrolled(
        "HList",
        -scrollbars => 'osoe',
        -selectmode => 'extended'
    )->pack(-fill => "both", -expand => 1);

}

MainLoop;


#
#  Inputs:  $1 ... the top-level widget 
#           $2 ... the image data
#
# Outputs:  $1 ... a pointer to the image for use with other widgets
#
sub make_image {
    my ($w, $data) = @_;
    my $img = $w->Pixmap(-data, $data);
    return $img;
}


#
#  Inputs:  $1 ... the widget being hovered over
#           $2 ... nonzero if entering, zero if leaving
#
sub hover_over_drop {
    my ($drop_site, $b_entry) = @_;
    $drop_site->configure(-bg => $b_entry == 1 ? 'hotpink' : 'skyblue'
+);
}


#
#  Inputs:  $1 ... the widget being dropped into
#           $2 ... the widget being dropped
#
sub perform_drop {
    my ($drop_site, $drop_obj) = @_;
    $drop_site->configure(-bg => 'skyblue');
    print "Debug:  Now do something with drop_obj $drop_obj\n";
}

[download]

Some notes:

  1. An "eyeball" symbol was added to show how you can drag something other than the default.
  2. A Canvas widget was added to each Frame, to have something to drag into.
  3. You need to create the widget you're dragging *before* you attempt to drag it (that may have been part of your problem, if you wanted to drag the Label widget).
  4. You should include Tk::DropSite in addition to Tk::DragDrop, and call the associated DropSite() method.
  5. I added the subroutines hover_over_drop() and perform_drop() which get called when the drop site is entered/exited, or has the widget dropped into it.
  6. The subroutine perform_drop() should be filled in with whatever action you want to take on the Label widget (named parameter $drop_obj) which is dropped.

I hope that may be of some use to you.

s''(q.S:$/9=(T1';s;(..)(..);$..=substr+crypt($1,$2),2,3;eg;print$..$/

In reply to Re: Drag & Drop Problem by liverpole
in thread Drag & Drop Problem by Ace128

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.