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";
}
Some notes:
- An "eyeball" symbol was added to show how you can drag something other than the default.
- A Canvas widget was added to each Frame, to have something to drag into.
- 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).
- You should include Tk::DropSite in addition to Tk::DragDrop, and call the associated DropSite() method.
- 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.
- 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$..$/
| [reply]
[d/l] |
LOVELY! Finlly I can make progress! Big Thanks!
1. Yea. Thanks. Knew about that.
2 and 3. Well, acually, tutorial I read seems to have missleaded me. I though you had to create this $drag_source from say $frame, and THEN create those you wanna have dragable on that drag source. Apparently you can just make anything dragable by $wanna_drag->DragDrop( ... );
4. Yea, I meantioned that too, but I just wanted the drag to work. Dropsource would be easy later...
5 & 6. Yea, thanks for making it easier for me.
Now, the dropframe is nice, but do you think there is some other better way to add a dropsite? I mean, the frame just for droping and is taking place. Im gonna try making.. say the whole pane. Then use some bbox or something to figure out where its dropped...
Update: Hmm, maybe implementation like Tk::Mlistbox.. (however it does it)
| [reply] |
Alrighty. Modified and updated that.
use Tk;
use Tk::HList;
use Tk::Pane;
use Tk::DragDrop;
use Tk::DropSite;
use strict;
use warnings;
my $mw = MainWindow->new;
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 $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,
)->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, -b
+g => "lightgray",
)->pack(-fill => "both");
# my $label = $frame->Button(-width => 30, -text => "Test" . $id,
# -command => sub { print "!!!!!!!!!!!!
+"; },
# )->pack(-fill => "both");
my $press = sub {
my ($c_src, $label_obj, $drag_source) = @_;
#$drag_id = $c_src_id;
#my $type = $c_src->type($drag_id);
$drag_source->configure(-text => $label_obj->cget(-text));
};
my $drag_source = $label->DragDrop(
-event => '<B1-Motion>',
-sitetypes => [qw/Local/],
#-image => $psym,
);
$label->bind('<ButtonPress-1>' => [$press, $label, $drag_source]);
#_dragOrSort($button);
#my $can = $frame->Canvas(-bg => 'skyblue')->pack();
my $hlist = $frame->Scrolled("HList",
-scrollbars => 'osoe',
-selectmode => 'extended'
)->pack(-fill => "both", -expand => 1);
my $drop = $hlist->DropSite(
-droptypes => [qw(Local)],
-dropcommand => [\&perform_drop, $label],
-entercommand => [\&hover_over_drop, $label],
# -dropcommand => [\&perform_drop, $can, $label],
# -entercommand => [\&hover_over_drop, $can, $label],
);
my $drop2 = $label->DropSite(
-droptypes => [qw(Local)],
-dropcommand => [\&perform_drop, $label],
-entercommand => [\&hover_over_drop, $label],
# -dropcommand => [\&perform_drop, $can, $label],
# -entercommand => [\&hover_over_drop, $can, $label],
);
}
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
# $3 ... label over
#
sub hover_over_drop {
my ($drop_site, $b_entry, $x_pos, $label_obj) = @_;
$drop_site->configure(-bg => $b_entry == 1 ? 'gray' : 'lightgray')
+;
if ($b_entry) {
#print $label_obj . "\n";
#$label_obj->cget(-text);
}
}
#
# Inputs: $1 ... the widget being dropped into
# $2 ... the widget being dropped
#
sub perform_drop {
my ($drop_site, $x_pos, $drop_obj) = @_;
#use Data::Dumper;
#print Dumper(@_);
#$pane->idletasks;
#$pane->update;
#$x_pos->configure(-bg => 'yellow');
#$drop_site->configure(-bg => 'yellow');
#$drop_site->configure(-bg => 'skyblue');
#print "Debug: Now do something with drop_obj $drop_obj " . $drop
+_obj->cget(-text) . "\n";
}
sub _dragOrSort {
my ($w, $c) = @_;
#my $w = $pane;
#unless ($w->cget('-moveable')) {
#if ($c->cget('-sortable')) {
# $w->sort (undef, $c);
#}
#return;
#}
my $h = shift; # The heading button of the column.
my $start_mouse_x = $h->pointerx;
my $y_pos = $h->rooty; # This is constant through the whole opera
+tion.
my $width = $h->width;
my $left_limit = $w->rootx - 1;
# Find the rightmost, visible column
my $right_end = 0;
foreach (@{$w->{'_columns'}}) {
if ($_->rootx + $_->width > $right_end) {
$right_end = $_->rootx + $_->width;
}
}
my $right_limit = $right_end + 1;
# Create a "copy" of the heading button, put it in a toplevel that
+ matches
# the size of the button, put the toplevel on top of the button.
my $tl=$w->Toplevel;
$tl->overrideredirect(1);
$tl->geometry(sprintf("%dx%d+%d+%d",
$h->width, $h->height, $h->rootx, $y_pos));
my $b=$tl->Button
(map{defined($_->[4]) ? ($_->[0]=>$_->[4]) : ()} $h->configure)
->pack(-expand=>1,-fill=>'both');
# Move the toplevel with the mouse (as long as Button-1 is down).
$h->bind("<Motion>", sub {
my $new_x = $h->rootx - ($start_mouse_x - $h->pointerx);
unless ($new_x + $width/2 < $left_limit ||
$new_x + $width/2 > $right_limit)
{
$tl->geometry(sprintf("+%d+%d",$new_x,$y_pos));
}
});
$h->bind("<ButtonRelease-1>", sub {
my $rootx = $tl->rootx;
my $x = $rootx + ($tl->width/2);
$tl->destroy; # Don't need this anymore...
$h->bind("<Motion>",''); # Cancel binding
if ($h->rootx == $rootx) {
# Button NOT moved, sort the column....
if ($c->cget('-sortable')) {
$w->sort(undef, $c);
}
return;
}
# Button moved.....
# Decide where to put the column. If the center of the dragged
# button is on the left half of another heading, insert it -before
# the column, otherwise insert it -after the column.
foreach (@{$w->{'_columns'}}) {
if ($_->ismapped) {
my $left = $_->rootx;
my $right = $left + $_->width;
if ($left <= $x && $x <= $right) {
if ($x - $left < $right - $x) {
$w->columnShow($c,-before=>$_);
} else {
$w->columnShow($c,'-after'=>$_);
}
$w->update;
$w->Callback(-configurecommand => $w);
}
}
}
});
}
One problem with this I've noticed. If I resize the columns, the drag and drop it still thinks the columns are the size they were! If I drap-n-drop one time, and try again, it works. So, how to fix this?
Oh, and I dont really get why I cant send the reference to the label into "hover_over_drop" and "perform_drop". All I get is "XdndSelection". Whats up with that?
_dragOrSort is taken from Tk::MlistBox. Not really used yet. Just there for reference if needed to be used later.
Btw, love such "hacks" as the eyeball! | [reply]
[d/l] |
As far as resizing columns, the only thing I can suggest is maybe you need to call a subroutine in response to pane resize events, and in that subroutine reissue the call to DropSite. As I said in my disclaimer, I'm not really familiar with DragDrop yet, and it doesn't look like it's especially well-commented.
With respect to sending the reference to the label into "hover_over_drop" and "perform_drop", can you show the exact code you're using to try to do that? It may just be (and this is an "off-the-wall" guess) that you have the wrong number of parameters to the subroutine where you're using the reference.
The "eyeball" hack, I have to admit, was just supposed to be a "bullseye"-like icon, but when I ran the code, it looked more like an "eyeball" than anything else!
s''(q.S:$/9=(T1';s;(..)(..);$..=substr+crypt($1,$2),2,3;eg;print$..$/
| [reply] |