Wx::GridTableBase
From WxPerl wiki
There are two ways to use grids: You can let Wx::Grid create the grid with its CreateGrid method, or you can derive a class from Wx::GridTableBase and apply that to the Grid via SetTable. The first method is quick and simple, but the grid can only display strings. The second method is a lot more involved but it provides vastly more flexibility. You can read about the easy way in WxGrid.
First off, with wxPerl you really want to derive your class from Wx::PlGridTable; Mattia has provided this interim class so that his XS code can provide some extra help and work in a more Perl-like way.
It's important to be aware of two things: PlGridTable is an interface, so that your class is responsible for providing all data storage and data access capabilities, and it's fronting for a C++ class which doesn't take kindly to methods returning undef. (Aside: I spent 3 days trying to figure out streams of warning messages about an uninitialized value in a subroutine entry. The problem turned out to be my GridTable's GetValue method returned undef if there wasn't a value to return.)
There are 3 classes of methods that your GridTable class must provide: Mandatory, Optional, and Optional taking a pointer.
The following are the mandatory methods: GetNumberCols, GetNumberRows, IsEmptyCell, GetValue, and SetValue. There are four more which the wxWidgets documentation identifies: GetTypeName, CanSetValueAs, GetValueAsXXX, and SetValueAsXXX. This is perl. We don't care about variable types. As long as you don't call the corresponding Grid methods (and why would you?), all will be well.
The next group of methods are optional. In some cases, there is code in the base class to cover for you; in others, if you don't call the corresponding Grid method, nothing will go wrong. Conservative types might want to define the methods anyway to issue a warning and return an appropriate default value (0 or empty string).
The optional methods are: Clear, SetView, GetView, InsertRows, InsertCols, AppendRows, AppendCols, DeleteRows, DeleteCols, GetRowLabelValue, GetColLabelValue, SetRowLabelValue, SetColLabelValue, SetAttrProvider, CanHaveAttributes, UpdateAttrRows, UpdateAttrCols, and GetAttr.
Finally, there are three optional methods which take an object pointer argument: SetAttr, SetRowAttr, and SetColAttr.
The methods SetView, GetView, SetAttr, and GetAttr seem to be already implemented, needing to be overridden only if you need to do something special. The Label methods are only required if you want different labels from the ones one traditionally finds on a spreadsheet (A,B, C,... across the top and 1, 2, 3, ... down the left side). InsertRow, InsertCol, AppendRow, AppendCol, DeleteRow, and DeleteCol need be overridden only if you want to be able to change the number of rows or columns after the call to Grid::SetTable.
On the subject of InsertRow and its mates, there is a requirement that at the time of this writing isn't documented in the regular wxWidgets docs (it is documented in the wxGrid topic in the wxWidgets Wiki): There is an undocumented class, Wx::GridTableMessage and an undocumented Wx::Grid method, Wx::Grid::ProcessTableMessage with which the GridTable must tell the Grid that the number of rows or columns have changed. The last thing your Insert, Delete, or Append method must do is
if (my $grid = $self->GetView) {
my $msg = Wx::GridTableMessage->new($self,
wxGRIDTABLE_NOTIFY_ROWS_DELETED,
$pos, $rows);
$grid->ProcessTableMessage($msg);
}
with the appropriate message, of course. The messages must be imported into your GridTable package:
use Wx qw(wxGRIDTABLE_NOTIFY_ROWS_INSERTED wxGRIDTABLE_NOTIFY_ROWS_DELETED
wxGRIDTABLE_NOTIFY_ROWS_APPENDED wxGRIDTABLE_NOTIFY_COLS_INSERTED
wxGRIDTABLE_NOTIFY_COLS_DELETED wxGRIDTABLE_NOTIFY_COLS_APPENDED);
The APPENDED messages don't have a $pos parameter, but in wxPerl 0.21 and older, the XS descripition requires all four parameters, so you have to call
my $msg = Wx::GridTableMessage->new($self, wxGRIDTABLE_NOTIFY_ROWS_APPENDED, $rows, 0);
Mattias has fixed this in CVS.
Here's my implementation. What you can't see is that I've made another class to hold the actual data for each cell. That allows for a complex data structure, and I've derived it from Wx::PlWindow in the hope that I can point a Wx::Validator at each cell.
package DBGridTable;
use strict;
use Carp qw(cluck carp croak confess);
use Data::Dumper;
use Wx;
use base qw(Wx::PlGridTable);
use Wx qw(wxGRIDTABLE_NOTIFY_ROWS_INSERTED wxGRIDTABLE_NOTIFY_ROWS_DELETED);
sub new {
my ($class, $args) = @_;
my $self = $class->SUPER::new;
$$self{cols} = scalar @{$$args{fields}};
$$self{coldata} = [];
$$self{rows} = 0;
return $self;
}
sub GetNumberCols {
my ($self) = @_;
return $$self{cols};
}
sub GetNumberRows {
my ($self) = @_;
return $$self{rows};
}
sub IsEmptyCell {
my ($self, $row, $col) = @_;
return defined $self->GetValue($row, $col) ? 1 : 0;
}
sub GetValue {
my ($self, $row, $col) = @_;
my $result = undef;
eval {
$result = $$self{array}->[$row][$col]->GetValue
if ($row < $self->GetNumberRows && $col < $self->GetNumberCols &&
defined $$self{array}->[$row][$col]);
$result = '' unless defined $result;
};
carp "Exception in DBGridTable::GetValue: $@" if $@;
return $result;
}
sub SetValue {
my ($self, $row, $col, $value) = @_;
croak "Array out of bounds"
unless $row < $self->GetNumberRows && $col < $self->GetNumberCols;
$$self{array}->[$row][$col]->SetValue($value);
}
sub GetPlData {
my ($self, $row, $col) = @_;
return undef
unless ($row < $self->GetNumberRows && $col < $self->GetNumberCols &&
defined $$self{array}->[$row][$col]);
return $$self{array}->[$row][$col]->GetPlData;
}
sub SetPlData {
my ($self, $row, $col, $data) = @_;
croak "Array out of bounds"
unless $row < $self->GetNumberRows && $col < $self->GetNumberCols;
$$self{array}->[$row][$col]->SetPlData($data);
}
#This is perl, after all...
sub CanSetValueAs {
my ($self, $row, $col, $type) = @_;
return 1 if ($row < $self->GetNumberRows && $col < $self->GetNumberCols);
return 0;
}
sub CanGetValueAs {
my $self = shift;
return $self->CanSetValueAs(@_);
}
sub Clear {
my ($self, $start, $end) = @_;
if (defined $start && defined $end) {
$start = 0 unless $start > 0;
$start = $$self{rows} - 1 if $start >= $$self{rows};
$end = $$self{rows} - 1 if $end >= $$self{rows};
$end = $start if $end < $start;
}
elsif (defined $start) {
$start = 0 unless $start > 0;
$start = $$self{rows} - 1 if $start >= $$self{rows};
$end = $start + 1;
}
else {
$start = 0;
$end = $$self{rows};
}
for (my $i = $start; $i < $end; $i++) {
$_->Clear foreach (@{$$self{array}->[$i]});
}
}
sub AppendRows {
my ($self, $rows) = @_;
}
sub InsertRows {
my ($self, $pos, $rows) = @_;
$rows = 1 unless defined $rows && $rows >= 0;
return 0 if $rows == 0;
eval {
$pos = $$self{rows} + $pos if $pos < 0;
$pos = 0 if $pos < 0;
$pos = $$self{rows} if $pos > $$self{rows};
for (my $row = $rows; $row >= $pos; $row--) {
$$self{array}->[$row + $rows] = $$self{array}->[$row];
$$self{array}->[$row] = $self->_newRow;
}
$$self{rows} += $rows;
if (my $grid = $self->GetView) {
my $msg = Wx::GridTableMessage->
new($self,
wxGRIDTABLE_NOTIFY_ROWS_INSERTED,
$pos, $rows);
$grid->ProcessTableMessage($msg);
}
};
if ($@) {
carp "DBGridTable::InsertRows Exception: $@";
return 0;
}
return 1;
}
sub _newRow {
my ($self) = @_;
my $row = [];
for (my $col = 0; $col < $$self{cols}; $col++) {
$$row[$col] = DBGridCell->new;
}
return $row;
}
sub DeleteRows {
my ($self, $pos, $rows) = @_;
return 0
unless defined $rows && $rows >= 0 &&
defined $pos && $pos >= 0 && $pos < $$self{rows};
if ($pos + $rows < $$self{rows}) {
for (my $row = $pos; $row < $pos + $rows; $row++) {
delete $$self{array}->[$row];
$$self{array}->[$row] = $$self{array}->[$row + $pos];
}
$$self{rows} -= $rows;
}
else {
$rows = $$self{rows} - $pos if $$self{rows} < $pos + $rows;
delete @{$$self{array}}[$pos .. $rows];
$$self{rows} -= $rows;
}
if (my $grid = $self->GetView) {
my $msg = Wx::GridTableMessage->new($self,
wxGRIDTABLE_NOTIFY_ROWS_DELETED,
$pos, $rows);
$grid->ProcessTableMessage($msg);
}
return 1;
}
sub SetAttr {
my ($self, $attr, $row, $col) = @_;
$row = $self->_checkRow($row);
$col = $self->_checkCol($col);
return unless (defined $row && defined $col);
$$self{array}->[$row][$col]->SetAttr($attr);
return;
}
sub SetColAttr {
my ($self, $attr, $col) = @_;
$col = $self->_checkCol($col);
return unless defined $col;
$$self{coldata}->[$col]->{attr} = $attr;
return;
}
sub GetAttr {
my ($self, $row, $col) = @_;
$row = $self->_checkRow($row);
$col = $self->_checkCol($col);
return undef unless (defined $row && defined $col);
my $attr = $$self{array}->[$row][$col]->GetAttr;
return defined $attr ? $attr : $self->GetColAttr($col);
}
sub GetColAttr {
my ($self, $col) = @_;
$col = $self->_checkCol($col);
return undef unless defined $col;
return $$self{coldata}->[$col]->{attr};
}
sub GetColLabelValue {
my ($self, $col) = @_;
$col = $self->_checkCol($col);
return undef unless defined $col;
return $$self{coldata}->[$col]->{label};
}
sub GetColLabelWidth {
my ($self, $col) = @_;
$col = $self->_checkCol($col);
return undef unless defined $col;
return $$self{coldata}->[$col]->{width};
}
sub SetColLabelWidth {
my ($self, $col, $width) = @_;
$col = $self->_checkCol($col);
return unless defined $col;
$$self{coldata}->[$col]->{width} = $width;
}
sub SetColLabelValue {
my ($self, $col, $value) = @_;
$col = $self->_checkCol($col);
return unless defined $col;
$$self{coldata}->[$col]->{label} = $value;
}
sub _checkCol {
my ($self, $col) = @_;
my $cols = $self->GetNumberCols;
return undef unless defined $col && abs($col) < $cols;
return $cols + $col if $col < 0;
return $col;
}
sub _checkRow {
my ($self, $row) = @_;
my $rows = $self->GetNumberRows;
return undef unless defined $row && abs($row) < $rows;
return $rows + $row if $row < 0;
return $row;
}
