Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery

wxPerl tutorial 3 --

by boo_radley (Parson)
on Oct 31, 2001 at 02:27 UTC ( [id://122227]=perltutorial: print w/replies, xml ) Need Help??

Continuing in the series.
This code takes up where the last tutorial left off -- displaying an image -- and the ability to add directories and images to a treeview for browsing. This does build on top of the other tutorials I've written, and so has less detailed commenting, as I assume you've read them. :-)
#!/usr/bin/perl use Wx ; package MyApp; use strict; use vars qw(@ISA); use Wx qw(:everything); use Wx::Event qw(EVT_MENU); @ISA=qw(Wx::App); sub OnInit { my $this = @_; my $frame = MyFrame->new( "Mini-image demo", [-1,-1], [-1,-1]); #my $this->{FRAME}=$frame; unless ($frame) {print "unable to create frame -- exiting."; ret +urn undef} $frame->Show( 1 ); 1; } package MyFrame; use vars qw(@ISA); use strict; # # All we load here are constants used # to keep the image stretched to the dimensions of the window. # use Wx qw(wxWidth wxHeight wxLeft wxTop wxDefaultPosition wxDefaul +tSize wxID_CANCEL wxCentreX wxCentreY); use Wx::Event qw(:everything); # # Wx::Image loads the Image control and all of the Image handler +s. # use Wx::Image; use IO::File; use Wx::Event ; @ISA=qw(Wx::Frame); sub new { my $class = shift; my $this = $class->SUPER::new( undef, -1, $_[0], $_[1], $_[2] +); # # replace the filename with something appropriate. # my $file = IO::File->new( "c:/docume~1/porterje/wx-ex.jpg", "r +" ); unless ($file) {print "Can't load file.";return undef}; binmode $file; my $handler = Wx::JPEGHandler->new(); my $image = Wx::Image->new(); my $bmp; # used to hold the bitmap. $handler->LoadFile( $image, $file ); $bmp = $image->ConvertToBitmap(); if( $bmp->Ok() ) { # create a static bitmap called ImageViewer that displays + the # selected image. $this->{ImageViewer}= Wx::StaticBitmap->new($this, -1, $bm +p); } $this->{ScaleImage}=0; $this->{TreeCtrl}= MyTreeCtrl->new($this, -1); $this->SetAutoLayout( 1 ); # allow wxperl to manage control s +izing & placement # Layout constraints provide the guides # for wxperl's autolayout. my $b1 = Wx::LayoutConstraints->new(); my $b2 = Wx::LayoutConstraints->new(); # These constrainst define the placement and # dimensions of the controls they're bound to, # and can be either absolute, or relative to # other controls $b1->left->Absolute(0); $b1->top->Absolute(0); $b1->width->PercentOf( $this, wxWidth,50); $b1->height->PercentOf( $this, wxHeight, 100); $this->{TreeCtrl}->SetConstraints($b1); $b2->left->RightOf($this->{TreeCtrl}); $b2->top->Absolute(0); $b2->width->PercentOf( $this, wxWidth,50); $b2->height->PercentOf( $this, wxHeight, 100); $this->{ImageViewer}->SetConstraints($b2); # # Set up the menu bar. # my $file_menu = Wx::Menu->new(); my ($OPEN_NEW_DIR, $REMOVE_DIR, $SCALE_IMAGE, $APP_QUIT)=(1..1 +00); $file_menu-> Append( $OPEN_NEW_DIR, "&Open A Directory\tCtrl-O +"); $file_menu->AppendSeparator(); $file_menu->Append($SCALE_IMAGE,"&Scale Images To Window\tCtrl +-S","",1); $file_menu->AppendSeparator(); $file_menu->Append ($APP_QUIT, "E&xit\tCtrl-x","Exit Applicati +on"); # # Note that even though there are 6 options, only # 4 of them are active as they're the only ones # bound to event handlers. # EVT_MENU($this, $OPEN_NEW_DIR, \&OnDirDialog); EVT_MENU($this, $SCALE_IMAGE, \&Set_Scale); EVT_MENU($this, $APP_QUIT, sub {$_[0]->Close( 1 )}); my $menubar= Wx::MenuBar->new(); $menubar->Append ($file_menu, "&File"); $this->SetMenuBar($menubar); $this; # return the frame object to the calling application. } # Set_Scale changes a scalar flag which will determine # if a displayed image is resized to fit the full # dimensions of the image control. sub Set_Scale { my $this = shift; # yes, I could have used NOT here. if ($this->{ScaleImage}){$this->{ScaleImage}=0} else {$this->{ +ScaleImage}=1}; } # # OnDirDialog scans a user specified directory for images. # sub OnDirDialog { my( $this, $event ) = @_; my $dialog = Wx::DirDialog->new( $this ); unless ( $dialog->ShowModal == wxID_CANCEL ) { $this->{TreeCtrl}->ScanDir($dialog->GetPath); } $dialog->Destroy; } package MyTreeCtrl; use vars qw (@ISA); use strict; use Wx qw(:everything); use Wx::Event qw(EVT_TREE_SEL_CHANGED EVT_TREE_ITEM_ACTIVATED) ; use Win32; use HTML::SimpleLinkExtor; use LWP::MediaTypes qw(guess_media_type); use LWP::UserAgent; @ISA=qw(Wx::TreeCtrl); sub new { my $class = shift; my $this = $class->SUPER::new( @_ ); EVT_TREE_SEL_CHANGED ($this,$this, \&OnChange); my $root=$this->AddRoot("Image listings"); #add one default it +em. $this; } # # Scandir adds a child node to the treeview that # lists the directory, and then sets each image file to # be a child of that newly created node. # sub ScanDir { my $this=shift; my $dir=shift; $dir =~tr/\\/\//; if ($dir !~/[\/]$/) {$dir.="/"} $dir=Win32::GetShortPathName($dir); my (@files) =glob "$dir*.jpg"; push @files, glob "$dir*.gif"; my $item = $this->AppendItem ($this->GetRootItem, "$dir (".scalar +@files.") files"); foreach (@files) {$this->AppendItem ($item,"$_")} } # # event handler for selecting different images. # sub OnChange { my ($this, $event) =@_; my $item = $event->GetItem(); if ($item== $this->GetRootItem()) {return} # return if user clicke +d on the root node. my $txt = $this->GetItemText($item); my $ext; my $handler; $txt=reverse $txt; if ($txt=~/^(.*?)\./){ $ext=lc(reverse($1)); } $txt=reverse ($txt); # this is cheesy, but the autosensing handler doesn't work, # or I can't get it to work appropriately. if ($ext eq "jpg"){$handler = Wx::JPEGHandler->new()}; if ($ext eq "gif"){$handler = Wx::GIFHandler->new()}; # create file my $file; $file = IO::File->new( $txt, "r" ) or return undef; binmode $file; return unless $handler; # exit if problems occur during handle cre +ation #and stuff into the image handler. my $image = Wx::Image->new(); my $bmp; # used to hold the bitmap. $handler->LoadFile( $image, $file ) or print "can't load file!"; $bmp = $image->ConvertToBitmap(); if( $bmp->Ok() ) { # create a static bitmap called ImageViewer that displays the # selected image. my $parent=$this->GetParent(); my $img =$parent->{ImageViewer}; my $size= $img->GetSize(); $img->SetBitmap($bmp); if ($parent->{ScaleImage}){$img->SetSize($size)}; $parent->Clear(); $img->Refresh; } } package main; my $app = MyApp->new(); # create $app->MainLoop(); # go

Replies are listed 'Best First'.
Tk && Wx ???
by Anonymous Monk on Mar 03, 2002 at 04:02 UTC
    Hello. I just started looking at the Wx stuff. Really awesome. I started looking at it while investigating ways to show some complex html in a Perl/Tk app I have. Tk::Web cannot load it. I hacked the Wx HTML demo to call it up, and it called it up great!!! Any ideas on using both the Wx and Tk Mainloops together. I would like to embed the Wx::HTML frame inside my Tk app. Any ideas. Thanke, Mike
      you scare me.
Re: wxPerl tutorial 3 --
by Anonymous Monk on Nov 29, 2002 at 13:07 UTC
    DO you really Need?
        use Win32;
        use HTML::SimpleLinkExtor;
        use LWP::MediaTypes qw(guess_media_type);
        use LWP::UserAgent;
Re: wxPerl tutorial 3 --
by Anonymous Monk on Dec 07, 2004 at 22:44 UTC
    Code out of date 2004/12/07.
      In any particular way? Or has it wound up on Mr. Blackwell's list of out-of-date code for 2004? Generating errors or new methods in Wx that obsolete something I've done? Help me out here.
        well, it doesn't work for me either. It seems that Wx::Image is not the current version of wx-perl. I've downloaded the lastest CPAN version (0.22) of Wx and I tried to install Wx::Image, but both failed in during the tests. So I installed the debian package of wx-perl. But no Wx::Image..

        maybe not everything has been ported from the wxwidgets 2.5 API? I have no idea...

Log In?

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perltutorial [id://122227]
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others lurking in the Monastery: (6)
As of 2024-05-28 12:55 GMT
Find Nodes?
    Voting Booth?

    No recent polls found