############################################################################# ## Name: lib/Wx/DemoModules/wxGridTable.pm ## Purpose: wxPerl demo hlper for wxGrid custom wxGridTable ## Author: Mattia Barbon ## Modified by: ## Created: 05/08/2003 ## RCS-ID: $Id: wxGridTable.pm 3118 2011-11-18 09:58:12Z mdootson $ ## Copyright: (c) 2003, 2005, 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::Grid; package Wx::DemoWindows::wxGridTable::Table; use strict; use base qw(Wx::PlGridTable); use Wx qw(wxRED wxGREEN); sub new { my( $class ) = @_; my $self = $class->SUPER::new; $self->{default} = Wx::GridCellAttr->new; $self->{red_bg} = Wx::GridCellAttr->new; $self->{green_fg} = Wx::GridCellAttr->new; $self->{red_bg}->SetBackgroundColour( wxRED ); $self->{green_fg}->SetTextColour( wxGREEN ); return $self; } sub GetNumberRows { 100000 } sub GetNumberCols { 100000 } sub IsEmptyCell { 0 } sub GetValue { my( $this, $y, $x ) = @_; return "($y, $x)"; } sub SetValue { my( $this, $x, $y, $value ) = @_; die "Read-Only table"; } sub GetTypeName { my( $this, $r, $c ) = @_; return $c == 0 ? 'bool' : $c == 1 ? 'double' : 'string'; } sub CanGetValueAs { my( $this, $r, $c, $type ) = @_; return $c == 0 ? $type eq 'bool' : $c == 1 ? $type eq 'double' : $type eq 'string'; } sub GetValueAsBool { my( $this, $r, $c ) = @_; return $r % 2; } sub GetValueAsDouble { my( $this, $r, $c ) = @_; return $r + $c / 1000; } sub GetAttr { my( $self, $row, $col, $kind ) = @_; return $self->{default} if $row % 2 && $col % 2; return $self->{red_bg} if $row % 2; return $self->{green_fg} if $col % 2; return Wx::GridCellAttr->new; } package Wx::DemoModules::wxGridTable; use strict; use base qw(Wx::Grid); use Wx::Event qw(EVT_GRID_CELL_LEFT_CLICK EVT_GRID_CELL_RIGHT_CLICK EVT_GRID_CELL_LEFT_DCLICK EVT_GRID_CELL_RIGHT_DCLICK EVT_GRID_LABEL_LEFT_CLICK EVT_GRID_LABEL_RIGHT_CLICK EVT_GRID_LABEL_LEFT_DCLICK EVT_GRID_LABEL_RIGHT_DCLICK EVT_GRID_ROW_SIZE EVT_GRID_COL_SIZE EVT_GRID_RANGE_SELECT EVT_GRID_SELECT_CELL); # events changed names in version 2.9.x my $events29plus = ( defined(&Wx::Event::EVT_GRID_CELL_CHANGED) ); sub new { my $class = shift; my $this = $class->SUPER::new( $_[0], -1 ); my $table = Wx::DemoWindows::wxGridTable::Table->new; $this->SetTable( $table ); EVT_GRID_CELL_LEFT_CLICK( $this, c_log_skip( "Cell left click" ) ); EVT_GRID_CELL_RIGHT_CLICK( $this, c_log_skip( "Cell right click" ) ); EVT_GRID_CELL_LEFT_DCLICK( $this, c_log_skip( "Cell left double click" ) ); EVT_GRID_CELL_RIGHT_DCLICK( $this, c_log_skip( "Cell right double click" ) ); EVT_GRID_LABEL_LEFT_CLICK( $this, c_log_skip( "Label left click" ) ); EVT_GRID_LABEL_RIGHT_CLICK( $this, c_log_skip( "Label right click" ) ); EVT_GRID_LABEL_LEFT_DCLICK( $this, c_log_skip( "Label left double click" ) ); EVT_GRID_LABEL_RIGHT_DCLICK( $this, c_log_skip( "Label right double click" ) ); EVT_GRID_ROW_SIZE( $this, sub { Wx::LogMessage( "%s %s", "Row size", GS2S( $_[1] ) ); $_[1]->Skip; } ); EVT_GRID_COL_SIZE( $this, sub { Wx::LogMessage( "%s %s", "Col size", GS2S( $_[1] ) ); $_[1]->Skip; } ); EVT_GRID_RANGE_SELECT( $this, sub { Wx::LogMessage( "Range %sselect (%d, %d, %d, %d)", ( $_[1]->Selecting ? '' : 'de' ), $_[1]->GetLeftCol, $_[1]->GetTopRow, $_[1]->GetRightCol, $_[1]->GetBottomRow ); $_[0]->ShowSelections; $_[1]->Skip; } ); if( $events29plus ) { Wx::Event::EVT_GRID_CELL_CHANGED( $this, c_log_skip( "Cell content changed" ) ); } else { Wx::Event::EVT_GRID_CELL_CHANGE( $this, c_log_skip( "Cell content changed" ) ); } EVT_GRID_SELECT_CELL( $this, c_log_skip( "Cell select" ) ); return $this; } sub ShowSelections { my $this = shift; my @cells = $this->GetSelectedCells; if( @cells ) { Wx::LogMessage( "Cells %s selected", join ', ', map { "(" . $_->GetCol . ", " . $_->GetRow . ")" } @cells ); } else { Wx::LogMessage( "No cells selected" ); } my @tl = $this->GetSelectionBlockTopLeft; my @br = $this->GetSelectionBlockBottomRight; if( @tl && @br ) { Wx::LogMessage( "Blocks %s selected", join ', ', map { "(" . $tl[$_]->GetCol . ", " . $tl[$_]->GetRow . "-" . $br[$_]->GetCol . ", " . $br[$_]->GetRow . ")" } 0 .. $#tl ); } else { Wx::LogMessage( "No blocks selected" ); } my @rows = $this->GetSelectedRows; if( @rows ) { Wx::LogMessage( "Rows %s selected", join ', ', @rows ); } else { Wx::LogMessage( "No rows selected" ); } my @cols = $this->GetSelectedCols; if( @cols ) { Wx::LogMessage( "Columns %s selected", join ', ', @cols ); } else { Wx::LogMessage( "No columns selected" ); } } # pretty printer for Wx::GridEvent sub G2S { my $event = shift; my( $x, $y ) = ( $event->GetCol, $event->GetRow ); return "( $x, $y )"; } # prety printer for Wx::GridSizeEvent sub GS2S { my $event = shift; my $roc = $event->GetRowOrCol; return "( $roc )"; } # creates an anonymous sub that logs and skips any grid event sub c_log_skip { my $text = shift; return sub { Wx::LogMessage( "%s %s", $text, G2S( $_[1] ) ); $_[0]->ShowSelections; $_[1]->Skip; }; } sub add_to_tags { qw(controls/grid) } sub title { 'Custom wxGridTable' } 1;