1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
|
#!/usr/local/bin/perl -w
use Tk;
use strict;
use Tk::DragDrop;
use Tk::DropSite;
my $top = MainWindow->new();
my $lb = $top->Scrolled('Listbox',-width => 40);
my $thing = $top->Message('-text' => "Drag This with B1")->pack;
my $source = $thing->DragDrop(-event => '<B1-Motion>',
-sitetypes => [qw(Local)],
-handlers => [[\&send_string], [-type => 'FILE_NAME', \&send_file]]);
my $loc = $top->Message('-text' => "Local Drops here", '-relief' => 'ridge' )->pack(-side => 'right');
$loc->DropSite(-droptypes => [qw(Local)], -dropcommand => [\&ShowTargets,$lb]);
$lb->pack(-side => 'bottom');
$top->Button('-text' => "Sites", '-command' => [\&ShowSites,$top])->pack('-side'=>'left');
$top->Button('-text' => "Quit", '-command' => ['destroy',$top])->pack('-side'=>'right');
MainLoop;
sub send_string
{
my ($offset,$max) = @_;
return "These are dropped Data";
}
sub send_file
{
my ($offset,$max) = @_;
return __FILE__;
}
sub ShowIt
{
my $w = shift;
my ($id,$x,$y,$width,$height) = @_;
my $t = $w->Toplevel;
$t->Button('-text'=>$id,'-command'=>['destroy',$t])->pack('-anchor'=>'c','-fill'=>'both');
$t->overrideredirect(1);
$t->update('idletasks');
$t->MoveResizeWindow($x,$y,$width,$height);
}
sub ShowTargets
{
my $lb = shift;
my $seln = shift;
my @targ = $lb->SelectionGet('-selection'=>$seln,'TARGETS');
$lb->delete(0,'end');
$lb->insert('end',@targ);
}
sub ShowSites
{
my $w = shift;
my @dnd = $w->SelectionGet('-selection'=>"_SUN_DRAGDROP_DSDM",
"_SUN_DRAGDROP_SITE_RECTS");
while (@dnd)
{
my $version = shift(@dnd);
my $site = shift(@dnd);
my $win = shift(@dnd);
my $x = shift(@dnd);
my $y = shift(@dnd);
my $width = shift(@dnd);
my $height = shift(@dnd);
my $flags = shift(@dnd);
ShowIt($w,sprintf("%x:%d",$win,$site),$x,$y,$width,$height);
}
}
|
