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] |
Haven't solved the resizeing problem yet, so if you feel up to it, you can check that out.
With the reference I meant that I was expecting the reference to $label created in the addCol to be send... but seems to be the one hovering over instead...
I changed to:
my $drop = $hlist->DropSite(
-droptypes => [qw(Local)],
-dropcommand => sub { perform_drop($label, @_) }, # New!
-entercommand => sub { hover_over_drop($label, @_) }, # New!
Just so I could see what was going on, and not possible loose the things send by the callback. But with this it still seems to be the label I was hoovering over... I wanted the label I was draging! Ofcource, there are other ways. Saveing the one dragged into some global variable... (easier and looks better in the module), but shouldn't passing the scalar to the sub work aswell? I mean, the $label is created in the same sub as that ->DropSite is mentioned. But it's still not the same label everytime, as it should be?
So, basicly, how can I pass the reference to the label I'm DRAGING? :)
Try this:
sub hover_over_drop {
my ($label_obj, $b_entry, $x_pos) = @_;
$label_obj->configure(-bg => $b_entry == 1 ? 'gray' : 'lightgray')
+;
#use Data::Dumper;
#print Dumper(@_);
if ($b_entry) {
#print $label_obj . "\n";
print $label_obj->cget(-text) . "\n";
}
}
And you see that the text is changing...
For instance, draging column #3 prints:
Test3
Test3
Test2
Test1
Test2
Test3
But, I was hoping for only "Test3". | [reply]
[d/l]
[select] |