#############################################################################
## Name: lib/Wx/DemoModules/wxClipboard.pm
## Purpose: wxPerl demo helper for Wx::Clipboard
## Author: Mattia Barbon
## Modified by:
## Created: 12/09/2001
## RCS-ID: $Id: wxClipboard.pm 3082 2011-07-04 16:40:16Z mdootson $
## Copyright: (c) 2001, 2003, 2006, 2011 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::wxClipboard;
use strict;
use base qw(Wx::Panel Class::Accessor::Fast);
use Wx qw(:dnd wxTheClipboard wxNullBitmap);
use Wx::Event qw(EVT_BUTTON);
use Wx::DemoModules::lib::DataObjects;
__PACKAGE__->mk_ro_accessors( qw(text image) );
sub new {
my $class = shift;
my $this = $class->SUPER::new( $_[0], -1 );
my $copy = Wx::Button->new( $this, -1, 'Copy Text', [ 20, 20 ] );
my $paste = Wx::Button->new( $this, -1, 'Paste', [ 120, 20 ] );
my $copy_im = Wx::Button->new( $this, -1, 'Copy Image', [ 20, 50 ] );
$this->{text} = Wx::StaticText->new( $this, -1, '', [ 220, 20 ] );
$this->{image} = Wx::StaticBitmap->new( $this, -1, wxNullBitmap,
[ 220, 150 ], [ 100, 100 ] );
EVT_BUTTON( $this, $copy, \&OnCopyText );
EVT_BUTTON( $this, $paste, \&OnPaste );
EVT_BUTTON( $this, $copy_im, \&OnCopyImage );
my $copy_both = Wx::Button->new( $this, -1, 'Copy Both', [ 20, 80 ] );
EVT_BUTTON( $this, $copy_both, \&OnCopyBoth );
# this does NOT work on WinXP
my $copy_pd = Wx::Button->new( $this, -1, 'Copy Data', [ 20, 110 ] );
EVT_BUTTON( $this, $copy_pd, \&OnCopyData );
# wxTheClipboard->UsePrimarySelection( 0 );
return $this;
}
sub _Copy {
my $data = shift;
wxTheClipboard->Open;
wxTheClipboard->SetData( $data );
wxTheClipboard->Close;
}
sub OnCopyText {
my( $this, $event ) = @_;
_Copy( get_text_data_object() );
Wx::LogMessage( "Copied some text" );
}
sub OnCopyImage {
my( $this, $event ) = @_;
_Copy( get_bitmap_data_object() );
Wx::LogMessage( "Copied an image" );
}
sub OnCopyBoth {
my( $this, $event ) = @_;
_Copy( get_text_bitmap_data_object() );
Wx::LogMessage( "Copied both text and image" );
}
sub OnCopyData {
my( $this, $event ) = @_;
my $PerlData = { fruit => 'lemon', colour => 'yellow' };
_Copy( get_perl_data_object( $PerlData ) );
Wx::LogMessage( "Copied perl data object: fruit=$PerlData->{fruit}, colour=$PerlData->{colour}" );
}
sub OnPaste {
my( $this, $event ) = @_;
wxTheClipboard->Open;
my $text = '';
# The cliboard may contain a composite object
# in which case, for GTK at least, we need to
# check for wxDF_UNICODETEXT in addition to
# wxDF_TEXT.
# wxDF_UNICODETEXT may not be wrapped in the
# version of Wx installed, so we may have to use
# a workaround.
my $unicodetext_wxwidgets_id = 13;
my $unicodetextformat = ( defined(&Wx::wxDF_UNICODETEXT) )
? wxDF_UNICODETEXT() : Wx::DataFormat->newNative( $unicodetext_wxwidgets_id );
if( wxTheClipboard->IsSupported( wxDF_TEXT ) || wxTheClipboard->IsSupported( $unicodetextformat ) ) {
my $data = Wx::TextDataObject->new;
my $ok = wxTheClipboard->GetData( $data );
if( $ok ) {
Wx::LogMessage( "Pasted text data" );
$text = $data->GetText;
} else {
Wx::LogMessage( "Error pasting text data" );
$text = '';
}
}
$this->text->SetLabel( $text );
my $bitmap = wxNullBitmap;
if( wxTheClipboard->IsSupported( wxDF_BITMAP ) ) {
my $data = Wx::BitmapDataObject->new;
my $ok = wxTheClipboard->GetData( $data );
if( $ok ) {
Wx::LogMessage( "Pasted bitmap data" );
$bitmap = $data->GetBitmap;
} else {
Wx::LogMessage( "Error pasting bitmap data" );
$bitmap = wxNullBitmap;
}
}
$this->image->SetBitmap( $bitmap );
# testing the perl data object
my $data = get_perl_data_object();
Wx::LogMessage( "Testing if clipboard supports: " . $data->GetFormat->GetId() );
if( wxTheClipboard->IsSupported( $data->GetFormat ) ) {
Wx::LogMessage( "It does: get data from clipboard" );
my $ok = wxTheClipboard->GetData( $data );
if( $ok ) {
Wx::LogMessage( "Pasted perl data object" );
my $PerlData = $data->GetPerlData();
foreach (keys %$PerlData) {
$text .= "$_ = $PerlData->{$_} ";
}
} else {
Wx::LogMessage( "Error pasting perl data object" );
$text = '';
}
$this->text->SetLabel( $text );
}
wxTheClipboard->Close;
}
sub add_to_tags { qw(dnd) }
sub title { 'wxClipboard' }
1;