#############################################################################
## Name: lib/Wx/DemoModules/wxDND.pm
## Purpose: wxPerl demo helper for Drag and Drop
## Author: Mattia Barbon
## Modified by:
## Created: 12/09/2001
## RCS-ID: $Id: wxDND.pm 2189 2007-08-21 18:15:31Z mbarbon $
## Copyright: (c) 2001, 2004, 2006 Mattia Barbon
## Licence: This program is free software; you can redistribute it and/or
## modify it under the same terms as Perl itself
#############################################################################
use Wx::DND;
package Wx::DemoModules::wxDND;
use strict;
use base qw(Wx::Panel);
use Wx qw(wxNullBitmap wxTheApp wxICON_HAND wxRED);
my $tree;
sub new {
my $class = shift;
my $this = $class->SUPER::new( @_ );
# text drop target
Wx::StaticText->new( $this, -1, 'Drop text in listbox', [ 10, 10 ] );
my $droptext = Wx::ListBox->new( $this, -1, [ 10 , 40 ], [ 150, 90 ] );
$droptext->SetDropTarget
( Wx::DemoModules::wxDND::TextDropTarget->new( $droptext ) );
# bitmap drop target
Wx::StaticText->new( $this, -1, 'Drop bitmap below', [ 180, 10 ] );
my $window = Wx::Panel->new( $this, -1, [ 180, 40 ], [ 80, 50 ] );
$window->SetBackgroundColour( wxRED );
my $dropbitmap = Wx::StaticBitmap->new( $this, -1, wxNullBitmap,
[ 180, 100 ], [ 200, 200 ] );
$window->SetDropTarget
( Wx::DemoModules::wxDND::BitmapDropTarget->new( $dropbitmap ) );
$dropbitmap->SetBitmap( Wx::Bitmap->new( wxTheApp->GetStdIcon( wxICON_HAND ) ) );
# files drop target
Wx::StaticText->new( $this, -1, 'Drop files below', [ 10, 140 ] );
my $dropfiles = Wx::ListBox->new( $this, -1, [ 10, 170 ], [ 150, 50 ] );
$dropfiles->SetDropTarget
( Wx::DemoModules::wxDND::FilesDropTarget->new( $dropfiles ) );
# drop source
my $dragsource =
Wx::DemoModules::wxDND::DropSource->new( $this, -1, [ 10, 230 ] );
# tree control; you can drop on items
Wx::StaticText->new( $this, -1, 'Drop bitmap in tree below', [ 300, 10 ] );
$tree = Wx::TreeCtrl->new( $this, -1, [ 300, 40 ], [ 100, 90 ] );
my $root = $tree->AddRoot( "Drop here" );
$tree->AppendItem( $root, "and here" );
$tree->AppendItem( $root, "and here" );
$tree->AppendItem( $root, "and here" );
$tree->Expand( $root );
$tree->SetDropTarget
( Wx::DemoModules::wxDND::TreeDropTarget->new( $tree, $dropbitmap ) );
# native perl data drop target
Wx::StaticText->new( $this, -1, 'Drop data below', [ 300, 140 ] );
my $dropdata = Wx::TextCtrl->new( $this, -1, '', [ 300, 170 ], [ 100, 50 ] );
$dropdata->SetDropTarget
( Wx::DemoModules::wxDND::DataDropTarget->new( $dropdata ) );
# drop data source
my $dragdatasource =
Wx::DemoModules::wxDND::DropDataSource->new( $this, -1, [ 300, 230 ] );
return $this;
}
sub add_to_tags { qw(dnd) }
sub title { 'Drag and drop' }
package Wx::DemoModules::wxDND::TreeDropTarget;
use strict;
use base qw(Wx::DropTarget);
sub new {
my $class = shift;
my $tree = shift;
my $canvas = shift;
my $this = $class->SUPER::new;
my $data = Wx::BitmapDataObject->new;
$this->SetDataObject( $data );
$this->{TREE} = $tree;
$this->{DATA} = $data;
$this->{CANVAS} = $canvas;
return $this;
}
sub data { $_[0]->{DATA} }
sub canvas { $_[0]->{CANVAS} }
use Wx qw(:treectrl wxDragNone wxDragCopy);
# give visual feedback: select the item we're on
# ( probably better forms of feedback are possible )
# also return the desired action to make the OS display an appropriate
# "can drop here" icon
sub OnDragOver {
my( $this, $x, $y, $desired ) = @_;
my $tree = $this->{TREE};
my( $item, $flags ) = $tree->HitTest( [$x, $y] );
if( $flags & wxTREE_HITTEST_ONITEMLABEL ) {
$tree->SelectItem( $item );
return $desired;
} else {
$tree->Unselect();
return wxDragNone;
}
}
sub OnData {
my( $this, $x, $y, $def ) = @_;
$this->GetData;
$this->canvas->SetBitmap( $this->data->GetBitmap );
return $def;
}
package Wx::DemoModules::wxDND::DropSource;
use strict;
use base qw(Wx::Window);
use Wx::Event qw(EVT_LEFT_DOWN EVT_PAINT);
use Wx::DemoModules::lib::DataObjects;
sub new {
my $class = shift;
my $this = $class->SUPER::new( @_[0,1,2], [200,50] );
EVT_PAINT( $this, \&OnPaint );
EVT_LEFT_DOWN( $this, \&OnDrag );
return $this;
}
sub OnPaint {
my( $this, $event ) = @_;
my $dc = Wx::PaintDC->new( $this );
$dc->DrawText( "Drag text/bitmap from here", 2, 2 );
}
sub OnDrag {
my( $this, $event ) = @_;
my $data = get_text_bitmap_data_object();
my $source = Wx::DropSource->new( $this );
$source->SetData( $data );
Wx::LogMessage( "Status: %d", $source->DoDragDrop( 1 ) );
}
package Wx::DemoModules::wxDND::TextDropTarget;
use strict;
use base qw(Wx::TextDropTarget);
sub new {
my $class = shift;
my $listbox = shift;
my $this = $class->SUPER::new( @_ );
$this->{LISTBOX} = $listbox;
return $this;
}
sub OnDropText {
my( $this, $x, $y, $data ) = @_;
$data =~ s/[\r\n]+$//;
Wx::LogMessage( "Dropped text: '$data'" );
$this->{LISTBOX}->InsertItems( [ $data ], 0 );
return 1;
}
package Wx::DemoModules::wxDND::FilesDropTarget;
use strict;
use base qw(Wx::FileDropTarget);
sub new {
my $class = shift;
my $listbox = shift;
my $this = $class->SUPER::new( @_ );
$this->{LISTBOX} = $listbox;
return $this;
}
sub OnDropFiles {
my( $this, $x, $y, $files ) = @_;
$this->{LISTBOX}->Clear;
Wx::LogMessage( "Dropped files at ($x, $y)" );
foreach my $i ( @$files ) {
$this->{LISTBOX}->Append( $i );
}
return 1;
}
package Wx::DemoModules::wxDND::BitmapDropTarget;
use strict;
use base qw(Wx::DropTarget);
sub new {
my $class = shift;
my $this = $class->SUPER::new;
my $data = Wx::BitmapDataObject->new;
$this->SetDataObject( $data );
$this->{DATA} = $data;
$this->{CANVAS} = $_[0];
return $this;
}
sub data { $_[0]->{DATA} }
sub canvas { $_[0]->{CANVAS} }
sub OnData {
my( $this, $x, $y, $def ) = @_;
$this->GetData;
$this->canvas->SetBitmap( $this->data->GetBitmap );
return $def;
}
package Wx::DemoModules::wxDND::DropDataSource;
use strict;
use base qw(Wx::Window);
use Wx::Event qw(EVT_LEFT_DOWN EVT_PAINT);
use Wx::DemoModules::lib::DataObjects;
sub new {
my $class = shift;
my $this = $class->SUPER::new( @_[0,1,2], [200,50] );
EVT_PAINT( $this, \&OnPaint );
EVT_LEFT_DOWN( $this, \&OnDrag );
return $this;
}
sub OnPaint {
my( $this, $event ) = @_;
my $dc = Wx::PaintDC->new( $this );
$dc->DrawText( "Drag perl data from here", 2, 2 );
}
sub OnDrag {
my( $this, $event ) = @_;
my $PerlData = { fruit => 'lemon', colour => 'yellow' };
my $data = get_perl_data_object( $PerlData );
my $source = Wx::DropSource->new( $this );
$source->SetData( $data );
Wx::LogMessage( "OnDrag Status: %d", $source->DoDragDrop( 1 ) );
}
package Wx::DemoModules::wxDND::DataDropTarget;
use strict;
use base qw(Wx::DropTarget);
use Wx::DemoModules::lib::DataObjects;
sub new {
my $class = shift;
my $this = $class->SUPER::new;
my $data = get_perl_data_object();
$this->SetDataObject( $data );
$this->{DATA} = $data;
$this->{TEXTCTRL} = $_[0];
return $this;
}
sub data { $_[0]->{DATA} }
sub textctrl { $_[0]->{TEXTCTRL} }
sub OnData {
my( $this, $x, $y, $def ) = @_;
Wx::LogMessage( "Dropped perl data at ($x, $y)" );
$this->GetData;
my $PerlData = $this->data->GetPerlData;
my $text = '';
foreach (keys %$PerlData) {
$text .= "$_ = $PerlData->{$_} ";
}
Wx::LogMessage( "( $text )" );
$this->textctrl->SetValue( $text );
return $def;
}
1;