Beefy Boxes and Bandwidth Generously Provided by pair Networks RobOMonk
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

Re: Wx::Perl: How to change/set font and size of Wx::ListCtrl column headings?

by jmlynesjr (Pilgrim)
on Mar 31, 2013 at 03:29 UTC ( #1026321=note: print w/ replies, xml ) Need Help??


in reply to Wx::Perl: How to change/set font and size of Wx::ListCtrl column headings?

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;

James

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


Comment on Re: Wx::Perl: How to change/set font and size of Wx::ListCtrl column headings?
Download Code
Re^2: Wx::Perl: How to change/set font and size of Wx::ListCtrl column headings?
by HelenCr (Monk) on Mar 31, 2013 at 17:03 UTC

    James: Thank you for this good work.

    In fact, like I said in an earlier post, I have realized I have to use "The Grid" (cringe) and I've written a little stand-alone program, which is, in many ways, similar to your example.
    Well, there is still something quite strange there: If you look at your example, line 94:

    sub GetValue { my( $grid, $y, $x ) = @_; return "($y, $x)"; }
    It seems that all cells should contain just
    "($y, $x)"
    Then,
    1. Why are the cells in column 1 empty (with alternating checkboxes - where did these come from)? and
    2. Why do we have in column 2:
    $r + $c / 1000;
    instead of
    "($y, $x)"
    (looks as if it came from line 122 in your code):
    sub GetValueAsDouble { # Row # plus (Col #/1000) my( $grid, $r, $c ) = @_; return $r + $c / 1000; }
    It's as if the system is calling GetValueAsDouble instead of GetValue. Why is that? I thought in wxVirtual, the system always calls GetValue?
    (I know that CanGetValueAs (line 108 in your code) is a cell accessor, and GetTypeName (line 100 in your code) sets column 1 type as boolean)

    Or, in other words, where is the renderer defined?
    I've read this wiki: http://wiki.wxperl.nl/Wx::GridTableBase but it doesn't make things much clearer

    Many TIA - Helen

      My pure guess is that sub GetTypeName() and sub CanGetValueAs() in defining column 0 as Bool, column 1 as Double and columns 2 through "last" as string is determining which cell renderer gets called for each column. Modify these subs to fit your column layout. Swap 0(bool) and 1(double) in both subs and see if the columns swap, I bet they will. (Tried this and they did swap!)

      Did you look at wxGridTableBase docs? You will probably have to create sub SetValue(), sub SetValueAsBool(), and sub SetValueAsDouble() subs to get your data into the Grid and possibly others to fit your specific data.

      I am out of ideas until there are specific questions to look into. I think you are close at this point.

      Update1: Swapped versions for completeness:

      sub GetTypeName { my( $grid, $r, $c ) = @_; return $c == 0 ? 'double' : # Col 0 Double $c == 1 ? 'bool' : # Col 1 Boolean 'string'; # All others String } sub CanGetValueAs { my( $grid, $r, $c, $type ) = @_; return $c == 0 ? $type eq 'double' : $c == 1 ? $type eq 'bool' : $type eq 'string'; }

      James

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

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://1026321]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chanting in the Monastery: (5)
As of 2014-04-20 04:06 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    April first is:







    Results (485 votes), past polls