RE: tkdnd
[email protected] ("Konovalov, Vadim (Vadim)** CTR **") Wed, 23 Feb 2011 14:31:55 +0100
| Newsgroups | perl.tcltk |
|---|---|
| Message-ID | <35BF8D9716175C43BB9D67CA60CC345E2770D21D@FRMRSSXCHMBSC2.dc-m.alcatel-lucent.com> |
> -----Original Message----- > From: gary sachs [mailto:[email protected]] > I am trying to implement drag and drop in a perl application. > The problem I am having at the moment is getting the drag to > work from a listbox to a entry widget. Activestate PERL 5.12 on XP. > > does any one have a small snippet of code showing the bind(s) > needed and their associated subroutines? I am also confused > on the order of the return values. Hi Gary you probably need inter-tk DND, Here is an example with Tcl::Tk usage, it shows miscellaneous drag-n-drops involving BWidget package use strict; use Tcl::Tk; my $mw = Tcl::Tk::MainWindow("Simple Drag & Drop Demo..."); my $int = $mw->interp; my $e = ''; my $e0 = 'la-bell'; my $w_e = $mw->Entry(-textvariable=>\$e)->pack(-fill=>'x'); my $w_l = $mw->Label(-textvariable=>\$e0)->pack(-fill=>'x'); $int->packageRequire('BWidget'); my $w_lb = $mw->Scrolled('Listbox',-selectmode=>'extended')->pack; $w_lb->_insertEnd("list item $_") for 'aaa' .. 'zzz'; $w_lb->_seeEnd; $int->call('DropSite::register', $w_l, -droptypes=> [text=>[copy=>'']], -dropcmd => sub { my $dt = shift; # drop target my $ds = shift; # drop source my ($x, $y) = (shift, shift); my $op = shift; # operation my ($datatype, $data) = (shift, shift); $e0 = $data; }); $int->call('DropSite::register', $w_e, -droptypes=> [text=>[copy=>'']], -dropcmd => sub { my ($dt, $ds, $x, $y, $op, $datatype, $data) = @_; $e = $data; }); $int->call('DropSite::register', $w_lb->Subwidget, -droptypes=> [text=>[copy=>'']], -dropcmd => sub { print "drop, $w_e;[[@_]]\n"; my $dt = shift; # drop target my $ds = shift; # drop source my ($x, $y) = (shift, shift); my $op = shift; # operation my ($datatype, $data) = (shift, shift); $w_lb->_insertEnd($data); $w_lb->_seeEnd; }); $int->call('DragSite::register', $w_l, -draginitcmd => sub { print "draginit, $w_l;[[@_]]\n"; return ['text','copy',$e0]; }); $int->call('DragSite::register', $w_lb->Subwidget, -draginitcmd => sub { print "draginit, $w_lb;[[@_]]\n"; return ['text','copy',join '+',map {$w_lb->get($_)} $w_lb->curselection]; }); $int->MainLoop; Also, here is a simple example that allows extra-application DND, which looks even simplier, but requires tkdnd package, I do not know if Activeperl comes with it pre-packaged (I wish it is prepackaged, but I do not know) use strict; use Tcl::Tk; my $mw = Tcl::Tk::MainWindow("Simple Drag & Drop Demo..."); my $int = $mw->interp; my $e = ''; my $lab = $mw->Entry(-textvariable=>\$e)->pack(-pady=>5, -fill=>'x'); # following line will do 'package require tkdnd' in Tcl/Tk $int->packageRequire('tkdnd','2.0'); $int->tkdnd__drop_target(register => $lab, "*"); # Add a specialised <<Drop>> event, when will be called if a file is dropped. $lab->bind('<<Drop:DND_Files>>', \\'D', sub { my $data = shift; ($e) = $int->SplitList($data); }); $int->MainLoop; And same program but with Tkx syntax: use strict; use Tkx; Tkx::package_require('tkdnd'); my $e; my $mw = Tkx::widget->new("."); my $w_edit = $mw->new_entry(-name=>".current_dir",-textvariable=>\$e); $w_edit->g_pack(qw '-fill both -expand true'); Tkx::tkdnd__drop___target_register($w_edit,'*'); Tkx::bind ($w_edit, '<<Drop:DND_Files>>', [ sub { $e = shift; print "I have '$e'\n"; }, Tkx::Ev("%D")]); Tkx::MainLoop; Best regards, Vadim.