Hi,
Apologies if this message arrives twice but my last few mails have been
swallowed by the ether so sending via different mail host.
Attached are two files, KWxLinearMeter.pm and lmeterdemo.pl.
As suggested by the names KWxLinearMeter.pm is the wrapped LinearMeter
control and lmeterdemo.pl is a simple app that displays some meter
instances.
KWxLinearMeter is implemented as far as possible as a simple translation
of LinearMeter.h and LinearMeter.cpp from the original source. It could
be implemented in a more Perlish way but I wanted the translation to be
obvious.
In your original code, you are creating window controls (or panels at
least) in your EVT_PAINT handler. This is a mistake. The EVT_PAINT
handler is called whenever part of your window needs refreshing. That
would be whenever the window is shown, resized, covered / uncovered by
other windows, amongst other things.
Hope it helps.
Mark
On 23/01/2013 15:43, James Lynes wrote:
Good morning:
I've recently ported several C++ wxIndustrial Controls to wxPerl and I'm
now abstracting the LinearMeter example into a module so that multiple
meters can exist on a window. I have a couple of questions that I hope the
group can help me with.
First: I create a frame. Create 6 panels. Write a label on each panel(just
to see if the panel is created in the correct location, it is). Create 6
meter objects. And draw the 6 meters(for testing just a filled box).
Instead of getting a window with 6 boxes with labels, I get a blank window
that gets 6 boxes drawn on it. Then the window goes back to the default
background color with 6 labels written on it. The filled boxes are
overwritten. I'm looking for 6 filled boxes with a label on them. What have
I missed?
Second: In the original port I have the following construct that works fine:
my @TagsVal;
push(@TagsVal, $val);
In my abstracted version I have translated this to:
$self->{TAGSVAL} = []; # Object array
definition
sub TagsVal { # Object
accessor definition
my $self = shift;
if(@_) {$self->{TAGSVAL} = @_}
return $self->{TAGSVAL};
}
push($Meter->TagsVal(), $val); # Don't think this
is correct syntax???
# want
to push $val into the object TAGSVAL array
Thanks for your input!
James
Source files attached: LinearMeter.pl Original Port
LinearMeter.pm Object version
LM.pl Object Main
Program
#########################################################################################
# Description: Demo for KWx::LinearMeter
# Created Fri Jan 25 21:07:51 2013
# svn id $Id:$
# Copyright: Copyright (c) 2013 Mark Dootson
# Licence: This work is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3 of the License, or any later
# version.
#########################################################################################
use strict;
use warnings;
use Wx;
#------------------------------------------
package Demo::MainWindow;
#------------------------------------------
use strict;
use warnings;
use Wx qw( wxTheApp :panel :window :id :misc :slider :colour :sizer :font);
use base qw( Wx::Frame );
use KWxLinearMeter;
use Wx::Event qw( EVT_COMMAND_SCROLL EVT_CLOSE );
sub new {
my $class = shift;
my $self = $class->SUPER::new( @_ );
my @initdata = ( 70, 0, 200 ); # val, min, max
#-----------------------------------
# Create Controls
#-----------------------------------
my $mainpanel = Wx::Panel->new($self, wxID_ANY,
wxDefaultPosition, wxDefaultSize, wxTAB_TRAVERSAL|wxBORDER_NONE);
my $draglabel = Wx::StaticText->new($mainpanel, wxID_ANY, 'Drag Me');
my $slider = Wx::Slider->new($mainpanel, wxID_ANY,
@initdata, , wxDefaultPosition, wxDefaultSize, wxSL_VERTICAL);
# add some Meters
my @bars;
for (my $i = 1; $i < 5; $i++) {
my $name = qq(Meter $i);
my $mlabel = Wx::StaticText->new($mainpanel, wxID_ANY, $name);
my $meter = KWxLinearMeter->new($mainpanel);
$meter->SetRangeVal($initdata[1], $initdata[2]);
$meter->SetActiveBarColour(wxBLUE);
$meter->SetPassiveBarColour(wxWHITE);
$meter->SetTxtLimitColour(wxBLACK);
$meter->SetTxtValueColour(wxRED);
$meter->SetBorderColour(wxRED);
$meter->SetTagsColour(wxGREEN) ;
$meter->SetTxtFont(Wx::Font->new(8, wxFONTFAMILY_MODERN, wxFONTSTYLE_NORMAL, wxFONTWEIGHT_NORMAL ));
$meter->SetOrizDirection(0);
$meter->ShowCurrent(1) ;
$meter->ShowLimits(1) ;
$meter->SetValue($initdata[0]);
for ( 20, 40, 60, 80, 120, 140, 160, 180 ) {
$meter->AddTag($_) ;
}
push (@bars, [ $mlabel, $meter] );
}
$self->{_bars} = \@bars;
#------------------------------------
# Events
#------------------------------------
EVT_COMMAND_SCROLL($self, $slider, sub { shift->_evt_slider( @_ ); } );
EVT_CLOSE($self,sub { shift->_evt_close( @_ ); } );
#------------------------------------
# Layout
#------------------------------------
my $mainsizer = Wx::BoxSizer->new(wxVERTICAL);
my $panelsizer = Wx::BoxSizer->new(wxHORIZONTAL);
my $slsizer = Wx::BoxSizer->new(wxVERTICAL);
$slsizer->Add($draglabel,0,wxALL|wxALIGN_CENTRE, 0);
$slsizer->Add($slider, 1, wxALL, 0);
$panelsizer->Add($slsizer, 0, wxEXPAND|wxALL, 5);
# add every meter
for my $meter ( @bars ) {
my $msizer = Wx::BoxSizer->new(wxVERTICAL);
$msizer->Add($meter->[0], 0, wxALL|wxALIGN_CENTRE, 0);
$msizer->Add($meter->[1], 1, wxALL|wxEXPAND, 0);
$panelsizer->Add($msizer, 1, wxEXPAND|wxALL, 5);
}
$mainpanel->SetSizer($panelsizer);
$mainsizer->Add($mainpanel,1,wxEXPAND|wxALL, 0);
$self->SetSizer($mainsizer);
return $self;
}
sub _evt_slider {
my( $self, $event) = @_;
my $pos = $event->GetPosition;
# update all the meters to the same value
for my $meter ( @{ $self->{_bars} } ) {
$meter->[1]->SetValue($pos);
}
}
sub _evt_close {
my( $self, $event) = @_;
$event->Skip(1);
$self->Destroy;
}
#------------------------------------------
package Demo::Application;
#------------------------------------------
use strict;
use warnings;
use Wx qw( :id );
use base qw( Wx::App );
sub new {
my $class = shift;
my $self = $class->SUPER::new( @_ );
return $self;
}
sub OnInit {
my $self = shift;
$self->SetVendorName('MarkDemos');
$self->SetAppName('Linear Meter Demonstration');
my $mwin = Demo::MainWindow->new(undef, wxID_ANY, $self->GetAppName );
$mwin->Show(1);
$self->SetTopWindow( $mwin );
return 1;
}
#------------------------------------------
package main;
#------------------------------------------
my $app = Demo::Application->new;
$app->MainLoop;
1;
#########################################################################################
# Package KWxLinearMeter
# Description: Linear Meter
# Created Fri Jan 25 19:12:49 2013
# SVN Id $Id:$
# Licence: This work is free software; you can redistribute it and/or
modify it
# under the terms of the GNU General Public License as published
by the
# Free Software Foundation; either version 3 of the License, or
any later
# version.
#
# The code is based on the C++ implementation provided in wxIndustrialControls:
# at http://www.koansoftware.com/en/prd_svil_wxdownload.htm
#
# Name: LinearMeter.cpp
# Purpose: wxIndustrialControls Library
# Author: Marco Cavallini <m.cavallini AT koansoftware.com>
# Modified by:
# Copyright: (C)2004-2006 Copyright by Koan s.a.s. - www.koansoftware.com
#########################################################################################
#########################################################################################
package KWxLinearMeter;
#########################################################################################
use strict;
use warnings;
use Wx qw( :misc :id :colour :font :brush :pen );
use base qw( Wx::Window );
use Wx::Event qw( EVT_PAINT EVT_SIZE);
use POSIX qw( ceil );
#-------------------------------------------
# Constructor
#-------------------------------------------
sub new {
my $class = shift;
# $_[0] = parent
$_[1] = wxID_ANY if not exists( $_[1] ); # windowid
$_[2] = wxDefaultPosition if not exists( $_[2] ); # pos
$_[3] = wxDefaultSize if not exists( $_[3] ); # size
$_[4] = 0 if not exists( $_[4] ); # style
my $self = $class->SUPER::new( @_ );
$self->{_privatedata} = KWxLinearMeter::Data->new({
ActiveBar => wxGREEN,
PassiveBar => wxWHITE,
ValueColour => wxRED,
BorderColour => wxRED,
LimitColour => wxBLACK,
TagsColour => wxGREEN,
ScaledVal => 0,
RealVal => 0,
Max => 100,
Min => 0,
DirOrizFlag => 1,
ShowCurrent => 1,
ShowLimits => 1,
Font => wxNORMAL_FONT,
Tags => [],
});
EVT_PAINT( $self, sub { shift->_evt_on_paint( @_ ); } );
EVT_SIZE( $self, sub { shift->_evt_on_size( @_ ); } );
return $self;
}
#---------------------------------------------------
# Simple Accessors
# Could be implemented using one of the many 'Class'
# CPAN modules - but implemented as below to closely
# match C++ method naming
#---------------------------------------------------
sub _pdata { $_[0]->{_privatedata}; }
sub SetRangeVal {
my ($self, $min, $max ) = @_;
$self->_pdata->Min($min);
$self->_pdata->Max($max);
}
sub SetActiveBarColour { $_[0]->_pdata->ActiveBar($_[1]); }
sub SetPassiveBarColour { $_[0]->_pdata->PassiveBar($_[1]); }
sub SetBorderColour { $_[0]->_pdata->BorderColour($_[1]); }
sub SetTagsColour { $_[0]->_pdata->TagsColour($_[1]); }
sub SetTxtLimitColour { $_[0]->_pdata->LimitColour($_[1]); }
sub SetTxtValueColour { $_[0]->_pdata->ValueColour($_[1]); }
sub SetTxtFont { $_[0]->_pdata->Font($_[1]); }
sub SetOrizDirection { $_[0]->_pdata->DirOrizFlag($_[1]); }
sub ShowCurrent { $_[0]->_pdata->ShowCurrent($_[1]); }
sub ShowLimits { $_[0]->_pdata->ShowLimits($_[1]); }
sub GetValue { $_[0]->_pdata->RealVal; }
#--------------------------------------------------
# Public methods with real implementations
#--------------------------------------------------
sub SetValue {
my( $self, $value) = @_;
$self->_pdata->RealVal($value);
$self->_calc_scaled_value;
return;
}
sub AddTag {
my( $self, $value) = @_;
push @{ $self->_pdata->Tags }, $value;
return;
}
#---------------------------------------------------
# Private methods
#---------------------------------------------------
sub _calc_scaled_value {
my $self = shift;
my ($w, $h) = $self->GetClientSizeWH;
my $oridim = ( $self->_pdata->DirOrizFlag ) ? $w - 2 : $h - 2;
my $coeff = $oridim / ( $self->_pdata->Max - $self->_pdata->Min );
$self->_pdata->ScaledVal(ceil(( $self->_pdata->RealVal -
$self->_pdata->Min) * $coeff));
$self->Refresh(0);
}
sub _draw_limits {
my($self, $dc, $w, $h) = @_;
# only ever called from within _evt_on_paint
$dc->SetFont( $self->_pdata->Font );
$dc->SetTextForeground( $self->_pdata->LimitColour);
if($self->_pdata->DirOrizFlag){
my $text = sprintf("%d", $self->_pdata->Min);
my( $tw, $th, $td, $tel) = $dc->GetTextExtent($text);
$dc->DrawText($text, 5, $h / 2 - $th / 2 );
$text = sprintf("%d", $self->_pdata->Max);
( $tw, $th, $td, $tel) = $dc->GetTextExtent($text);
$dc->DrawText($text, $w - $tw - 5, $h / 2 - $th / 2);
} else {
my $text = sprintf("%d", $self->_pdata->Min);
my( $tw, $th, $td, $tel) = $dc->GetTextExtent($text);
$dc->DrawText($text, $w / 2 - $tw / 2, $h - $th - 5 );
$text = sprintf("%d", $self->_pdata->Max);
( $tw, $th, $td, $tel) = $dc->GetTextExtent($text);
$dc->DrawText($text, $w / 2 - $tw / 2, 5);
}
}
sub _draw_current {
my($self, $dc, $w, $h) = @_;
# only ever called from within _evt_on_paint
my $text = sprintf("%d", $self->_pdata->RealVal);
my( $tw, $th, $td, $tel) = $dc->GetTextExtent($text);
$dc->SetTextForeground($self->_pdata->ValueColour);
$dc->DrawText($text, $w / 2 - $tw / 2 , $h / 2 - $th / 2);
}
sub _draw_tags {
# only ever called from within _evt_on_paint
my($self, $dc, $w, $h) = @_;
my $orival = ( $self->_pdata->DirOrizFlag ) ? $w - 2 : $h - 2;
my $tcoeff = $orival / ($self->_pdata->Max - $self->_pdata->Min);
$dc->SetPen( Wx::Pen->new($self->_pdata->TagsColour, 1, wxSOLID));
$dc->SetBrush( Wx::Brush->new($self->_pdata->TagsColour, wxSOLID));
$dc->SetTextForeground( $self->_pdata->TagsColour );
for my $tag ( @{ $self->_pdata->Tags } ) {
my $scalval = ceil(($tag - $self->_pdata->Min) * $tcoeff);
my $text = sprintf("%d", $tag);
if( $self->_pdata->DirOrizFlag ){
$dc->DrawLine($scalval + 1, $h - 2 , $scalval + 1, $h - 10);
my($tw, $th, $td, $tel) = $dc->GetTextExtent($text);
$dc->DrawText($text, $scalval + 1 - ($tw / 2 ), $h - 10 - $th);
} else {
$dc->DrawLine($w - 2, $h - $scalval , $w - 10 , $h - $scalval);
my($tw, $th, $td, $tel) = $dc->GetTextExtent($text);
$dc->DrawText($text, $w - 10 - $tw, $h - $scalval - ($th / 2) );
}
}
}
#----------------------------------------------------
# Event handlers
#----------------------------------------------------
sub _evt_on_size {
my( $self, $event ) = @_;
$event->Skip(1);
$self->_calc_scaled_value;
}
sub _evt_on_paint {
my( $self, $event ) = @_;
my $dc = Wx::AutoBufferedPaintDC->new($self);
my ($w, $h) = $self->GetClientSizeWH;;
# Clear Background
{
my $bbrush = Wx::Brush->new($self->_pdata->PassiveBar, wxSOLID);
$dc->SetBackground( $bbrush );
$dc->SetBrush( $bbrush );
$dc->Clear;
}
# Draw Border
$dc->SetPen( Wx::Pen->new( $self->_pdata->BorderColour, 1, wxSOLID ));
$dc->DrawRectangle(0, 0, $w, $h);
# Draw Active Bar
$dc->SetPen( Wx::Pen->new( $self->_pdata->ActiveBar, 1, wxSOLID ));
$dc->SetBrush( Wx::Brush->new($self->_pdata->ActiveBar, wxSOLID ));
my $scaledval = $self->_pdata->ScaledVal;
if( $self->_pdata->DirOrizFlag ) {
$dc->DrawRectangle(1, 1, $scaledval, $h - 2);
} else {
my $yPoint = $h - $scaledval ;
my $rh; # height
if ($scaledval == 0 ) {
$rh = $scaledval ;
} else {
if ($self->_pdata->RealVal == $self->_pdata->Max) {
$rh = $scaledval;
$yPoint -= 1 ;
} else {
$rh = $scaledval - 1 ;
}
}
$dc->DrawRectangle(1, $yPoint, $w - 2, $rh);
}
$self->_draw_current( $dc, $w, $h ) if $self->_pdata->ShowCurrent;
$self->_draw_limits( $dc, $w, $h ) if $self->_pdata->ShowLimits;
$self->_draw_tags( $dc, $w, $h ) if @{ $self->_pdata->Tags } > 0;
return 1;
}
#########################################################################################
package KWxLinearMeter::Data;
#########################################################################################
use strict;
use warnings;
use Class::Accessor::Fast;
use base qw( Class::Accessor::Fast );
__PACKAGE__->mk_accessors( qw( ActiveBar PassiveBar ValueColour BorderColour
LimitColour TagsColour ScaledVal RealVal Max Min DirOrizFlag ShowCurrent
ShowLimits Font Tags ) );
sub new { shift->SUPER::new( @_ ); }
1;
