Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
PerlMonks  

comment on
( [id://3333]=superdoc: print w/replies, xml ) Need Help??

Based on references provided by AM above, attached is a stand-alone example of a customized "Virtual" wxGridTable control. I don't do SQL, so hopefully someone can expand this into a complete example of displaying SQL table results with wxPerl.

#! /home/xxxx/CitrusPerl/perl/bin/perl
######################################################################
+#######
## 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
######################################################################
+#######

# wxGridTable.pl
# wxGridTable.pm modified into a standalone test program for a "Virtua
+l" Grid control with
#    custom Column and Row header text, fonts, colors, sizes and sever
+al other
#    configurable options. The data and mouse events are unchanged fro
+m the original example.
# Combines the wxDemo wxGridTable.pm with my Grid.pl test code(see PM 
+post below) along
#     with the  http://wiki.wxperl.nl/Wx::GridTableBase example.
# See the  Perl Monks post: http://www.perlmonks.org/?node=1025489
#    "Wx::Perl: How to change/set font and size of Wx::ListCtrl column
+ headings?"
#    for the history of this example code.    
# Last Modified: James M. Lynes Jr. March 30,2013

package main;
use strict;
use warnings;
my $app = App->new();
$app->MainLoop;

package App;
use strict;
use warnings;
use base 'Wx::App';
sub OnInit {
    my $frame = Frame->new();
    $frame->Show(1);
}

package Frame;
use strict;
use warnings;
use Wx qw(:everything);
use base qw(Wx::Frame);
use Data::Dumper;

sub new {
    my($self) = @_;

    $self = $self->SUPER::new(undef, -1, "wxGridTable.pl - Virtual Gri
+d Control Example", 
                              wxDefaultPosition, [950,650]);
    my $gtapp = MyGridTableApp->new($self);
    return $self;
}
1;

# Custom Grid Table sub-classed from PlGridTable called from MyGridTab
+leApp
package MyGridTable;

use strict;
use warnings;
use Wx qw(:everything);
use Wx::Grid;
use base qw(Wx::PlGridTable);
use Data::Dumper;

use Wx qw(wxRED wxGREEN);

sub new {
  my( $class ) = @_;
  my $self = $class->SUPER::new;

  $self->{default} = Wx::GridCellAttr->new;            # Cell attribut
+es for demo purposes
  $self->{red_bg} = Wx::GridCellAttr->new;
  $self->{green_fg} = Wx::GridCellAttr->new;

  $self->{red_bg}->SetBackgroundColour( wxRED );
  $self->{green_fg}->SetTextColour( wxGREEN );

  return $self;
}

# Overridden Methods from the base class - these get modified/expanded
+ in a real app
sub GetNumberRows { 1000 }                    # Base demo is set for 1
+00000 x 100000
sub GetNumberCols { 10 }
sub IsEmptyCell { 0 }

sub GetValue {
  my( $grid, $y, $x ) = @_;

  return "($y, $x)";
}

sub SetValue {
  my( $grid, $x, $y, $value ) = @_;

  die "Read-Only table";
}

sub GetTypeName {
  my( $grid, $r, $c ) = @_;

  return $c == 0 ? 'bool' :                    # Col 0 Boolean
         $c == 1 ? 'double' :                    # Col 1 Double
                   'string';                    # All others String
}

sub CanGetValueAs {
  my( $grid, $r, $c, $type ) = @_;

  return $c == 0 ? $type eq 'bool' :
         $c == 1 ? $type eq 'double' :
                   $type eq 'string';
}

sub GetValueAsBool {                        # Even rows false
  my( $grid, $r, $c ) = @_;                    # Odd rows true

  return $r % 2;
}

sub GetValueAsDouble {                        # Row # plus (Col #/1000
+)
  my( $grid, $r, $c ) = @_;

  return $r + $c / 1000;
}

sub GetAttr {                            # Cell attributes
  my( $grid, $row, $col, $kind ) = @_;

  return $grid->{default} if $row % 2 && $col % 2;        # Odd rows a
+nd odd cols default format
  return $grid->{red_bg} if $row % 2;                # Odd rows only -
+ red background
  return $grid->{green_fg} if $col % 2;                # Odd cols only
+ - green foreground text
  return Wx::GridCellAttr->new;                    # Even rows and eve
+n cols - default format 
}

sub SetColLabelValue {                        # Copied from the wiki f
+or custom labels
   my ($grid, $col, $value) = @_;
   $col = $grid->_checkCol($col);
   return unless defined $col;
   $$grid{coldata}->[$col]->{label} = $value;
}

sub GetColLabelValue {                        # Copied from the wiki f
+or custom labels
   my ($grid, $col) = @_;
   $col = $grid->_checkCol($col);
   return undef unless defined $col;
   return $$grid{coldata}->[$col]->{label};
}

sub _checkCol {                            # Copied from the wiki for 
+custom labels
   my ($grid, $col) = @_;
   my $cols = $grid->GetNumberCols;
   return undef unless defined $col && abs($col) < $cols;
   return $cols + $col if $col < 0;
   return $col;
}

sub SetRowLabelValue {                        # Modeled after the wiki
+ for custom labels
   my ($grid, $row, $value) = @_;
   $row = $grid->_checkRow($row);
   return unless defined $row;
   $$grid{rowdata}->[$row]->{label} = $value;
}

sub GetRowLabelValue {                        # Modeled after the wiki
+ for custom labels
   my ($grid, $row) = @_;
   $row = $grid->_checkRow($row);
   return undef unless defined $row;
   return $$grid{rowdata}->[$row]->{label};
}

sub _checkRow {                            # Modeled after the wiki fo
+r custom labels
   my ($grid, $row) = @_;
   my $rows = $grid->GetNumberRows;
   return undef unless defined $row && abs($row) < $rows;
   return $rows + $row if $row < 0;
   return $row;
}

# Demo application for an enhanced "Virtual" Grid Control - fromm wxPe
+rl Demo application
package MyGridTableApp;

use strict;
use warnings;
use Wx qw(:everything);
use base qw(Wx::Grid);
use Data::Dumper;

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, $frame) = @_;
  my $grid = $class->SUPER::new($frame, wxID_ANY, wxDefaultPosition,  
+      # Grid object
                   Wx::Size->new(950,700));

  my $table = MyGridTable->new;                            # Virtual T
+able object
  $grid->SetTable( $table );

# Custom Grid Formatting Examples- text, fonts, colors, sizes, gridlin
+es - from Grid.pl
    $grid->SetLabelBackgroundColour(wxBLUE);
    $grid->SetLabelTextColour(Wx::Colour->new("yellow"));
    $grid->SetLabelFont(Wx::Font->new(14, wxFONTFAMILY_ROMAN, wxNORMAL
+, wxBOLD));
    $grid->SetColLabelSize(40);                # Col height
    $grid->SetRowLabelSize(100);                # Row height - 0 hides
+ the row labels
    $grid->SetDefaultColSize(120,1);            # Default Cell width (
+Fit overrides)
    $grid->SetDefaultRowSize(40,1);                # Default Cell Heig
+ht (Fit overrides)
    $grid->EnableGridLines(1);                # Grid lines 1-on, 0-off
    $grid->SetGridLineColour(wxBLUE);
    $grid->SetSelectionMode(wxGridSelectRows);        # Always select 
+complete rows
    $grid->SetSelectionForeground(wxRED);
        $grid->SetSelectionBackground(wxGREEN);            # Click wit
+hin grid, background goes green
                                # Click on row label, background stays
+ black
                                # until clicking within grid, then gre
+en(???)

        for my $c (0..$grid->GetNumberCols()-1) {        # Column Head
+er Text
            my $cptr = $c+1;
            $grid->SetColLabelValue($c, "Col $cptr");
        }

        for my $r (0..$grid->GetNumberRows()-1) {        # Row Header 
+Text
            my $rptr = $r+1;
            $grid->SetRowLabelValue($r, "Row $rptr");
        }

# Sample Events - logs the events
  EVT_GRID_CELL_LEFT_CLICK( $grid, c_log_skip( "Cell left click" ) );
  EVT_GRID_CELL_RIGHT_CLICK( $grid, c_log_skip( "Cell right click" ) )
+;
  EVT_GRID_CELL_LEFT_DCLICK( $grid, c_log_skip( "Cell left double clic
+k" ) );
  EVT_GRID_CELL_RIGHT_DCLICK( $grid, c_log_skip( "Cell right double cl
+ick" ) );
  EVT_GRID_LABEL_LEFT_CLICK( $grid, c_log_skip( "Label left click" ) )
+;
  EVT_GRID_LABEL_RIGHT_CLICK( $grid, c_log_skip( "Label right click" )
+ );
  EVT_GRID_LABEL_LEFT_DCLICK( $grid, c_log_skip( "Label left double cl
+ick" ) );
  EVT_GRID_LABEL_RIGHT_DCLICK( $grid, c_log_skip( "Label right double 
+click" ) );

  EVT_GRID_ROW_SIZE( $grid, sub {
                       Wx::LogMessage( "%s %s", "Row size", GS2S( $_[1
+] ) );
                       $_[1]->Skip;
                     } );
  EVT_GRID_COL_SIZE( $grid, sub {
                       Wx::LogMessage( "%s %s", "Col size", GS2S( $_[1
+] ) );
                       $_[1]->Skip;
                     } );

  EVT_GRID_RANGE_SELECT( $grid, sub {
                           Wx::LogMessage( "Range %sselect (%d, %d, %d
+, %d)",
                                           ( $_[1]->Selecting ? '' : '
+de' ),
                                           $_[1]->GetLeftCol, $_[1]->G
+etTopRow,
                                           $_[1]->GetRightCol,
                                           $_[1]->GetBottomRow );
                           $_[0]->ShowSelections;
                           $_[1]->Skip;
                         } );
  
  if( $events29plus ) {
        Wx::Event::EVT_GRID_CELL_CHANGED( $grid, c_log_skip( "Cell con
+tent changed" ) );
    } else {
        Wx::Event::EVT_GRID_CELL_CHANGE( $grid, c_log_skip( "Cell cont
+ent changed" ) );
  }
  
  EVT_GRID_SELECT_CELL( $grid, c_log_skip( "Cell select" ) );

  return $grid;
}

sub ShowSelections {
    my $grid = shift;

    my @cells = $grid->GetSelectedCells;
    if( @cells ) {
        Wx::LogMessage( "Cells %s selected", join ', ',
                                                  map { "(" . $_->GetC
+ol .
                                                        ", " . $_->Get
+Row . ")"
                                                       } @cells );
    } else {
        Wx::LogMessage( "No cells selected" );
    }

    my @tl = $grid->GetSelectionBlockTopLeft;
    my @br = $grid->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 = $grid->GetSelectedRows;
    if( @rows ) {
        Wx::LogMessage( "Rows %s selected", join ', ', @rows );
    } else {
        Wx::LogMessage( "No rows selected" );
    }

    my @cols = $grid->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;
  };
}
1;

[download]

James

There's never enough time to do it right, but always enough time to do it over...

In reply to Re: Wx::Perl: How to change/set font and size of Wx::ListCtrl column headings? by jmlynesjr
in thread Wx::Perl: How to change/set font and size of Wx::ListCtrl column headings? by HelenCr

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":


  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others contemplating the Monastery: (3)
As of 2024-04-24 03:11 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found