Perl实现拖拽的例子

最新推荐文章于 2021-09-22 14:29:11 发布

原创最新推荐文章于 2021-09-22 14:29:11 发布 · 1.4k 阅读

0 ·

CC 4.0 BY-SA版权

文章标签：

#perl #token #callback #insert #button #delete

Perl /Tk/ DBI 专栏收录该内容

9 篇文章

订阅专栏

此博客展示了使用Perl语言实现列表项拖放功能的代码。通过使用Tk及其相关模块，定义了拖放源和目标，实现了从左侧列表拖动项到右侧列表的操作，包含开始拖动和接受放下的回调函数，完成项的插入和删除。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

#!/usr/bin/perl -w

use Tk;
use Tk::DragDrop;
use Tk::DropSite;
use Tk::HList;
use strict;
use vars qw($top $f $lb_src $lb_dest $dnd_token $drag_entry);

$top = new MainWindow;

$top->Label(-text => "Drag items from the left HList to the right one"
)->pack;
$f = $top->Frame->pack;
$lb_src = $f->Scrolled('HList', -scrollbars => "osoe", -selectmode => 'dragdrop')
->pack(-side => "left");
$lb_dest = $f->Scrolled('HList', -scrollbars => "osoe", -selectmode => 'dragdrop')
->pack(-side => "left");

my $i=0;
foreach (sort keys %ENV) {
$lb_src->add($i++, -text =>

___FCKpd___0

);
}
# Define the source for drags.
# Drags are started while pressing the left mouse button and moving the
# mouse. Then the StartDrag callback is executed.
$dnd_token = $lb_src->DragDrop
(-event     => '<B1-Motion>',
-sitetypes => ['Local'],
-startcommand => sub { StartDrag($dnd_token) },
);
# Define the target for drops.
$lb_dest->DropSite
(-droptypes     => ['Local'],
-dropcommand   => [ /&Drop, $lb_dest, $dnd_token ],
);
MainLoop;
sub StartDrag {
my($token) = @_;
my $w = $token->parent; # $w is the source hlist
my $e = $w->XEvent;
$drag_entry = $w->nearest($e->y); # get the hlist entry under cursor
if (defined $drag_entry) {
# Configure the dnd token to show the hlist entry
$token->configure(-text => $w->entrycget($drag_entry, '-text'));
# Show the token
my($X, $Y) = ($e->X, $e->Y);
$token->MoveToplevelWindow($X, $Y);
$token->raise;
$token->deiconify;
$token->FindSite($X, $Y, $e);
}
}
# Accept a drop and insert a new item in the destination hlist and delete
# the item from the source hlist
sub Drop {
my($lb, $dnd_source) = @_;
my $end = ($lb->info("children"))[-1];
my @pos = (-after => $end) if defined $end;
my $y = $lb->pointery - $lb->rooty;
my $nearest = $lb->nearest($y);
if (defined $nearest) {
my(@bbox) = $lb->infoBbox($nearest);
if ($y > ($bbox[3]-$bbox[1])/2+$bbox[1]) {
@pos = (-after => $nearest);
} else {
@pos = (-before => $nearest);
}
}
$lb->add($drag_entry, @pos, -text => $dnd_source->cget(-text));
$lb_src->delete("entry", $drag_entry);
$lb->see($drag_entry);
}
__END__