diff options
Diffstat (limited to 'Master/tlpkg/tlperl0/lib/Tk/DragDrop/Win32Site.pm')
-rwxr-xr-x | Master/tlpkg/tlperl0/lib/Tk/DragDrop/Win32Site.pm | 50 |
1 files changed, 50 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl0/lib/Tk/DragDrop/Win32Site.pm b/Master/tlpkg/tlperl0/lib/Tk/DragDrop/Win32Site.pm new file mode 100755 index 00000000000..f45d06bc92b --- /dev/null +++ b/Master/tlpkg/tlperl0/lib/Tk/DragDrop/Win32Site.pm @@ -0,0 +1,50 @@ +package Tk::DragDrop::Win32Site; + +use vars qw($VERSION); +$VERSION = sprintf '4.%03d', q$Revision: #8 $ =~ /\D(\d+)\s*$/; + +use Tk qw($XS_VERSION); +require DynaLoader; +require Tk::DropSite; + +use base qw(Tk::DropSite DynaLoader); + +bootstrap Tk::DragDrop::Win32Site; + +use strict; + +Tk::DropSite->Type('Win32'); + +sub WM_DROPFILES () {563} + +sub InitSite +{ + my ($class,$site) = @_; + my $w = $site->widget; + $w->BindClientMessage(WM_DROPFILES,[\&Win32Drop,$site]); + DragAcceptFiles($w,1); +} + +sub Win32Drop +{ + # print join(',',@_),"\n"; + my ($w,$site,$msg,$wParam,$lParam) = @_; + my ($x,$y,@files) = DropInfo($wParam); + my $cb = $site->{'-dropcommand'}; + $site->Apply(-entercommand => $x, $y, 1); + if ($cb) + { + foreach my $file (@files) + { + # print "$file @ $x,$y\n"; + $w->clipboardClear; + $w->clipboardAppend('--',$file); + $cb->Call('CLIPBOARD',Win32Drop => ['STRING'],$x,$y); + } + } + $site->Apply(-entercommand => $x, $y, 0); + return 0; +} + +1; +__END__ |