Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

comment on
( [id://3333]=superdoc: print w/replies, xml ) Need Help??
Solved - See Update Below. Also added readmore tags to first example.

Alert: Cross-posted to wxPerl_users@perl.org

I recently found a 2003 wxPerl script for taking screen shots here on Perl Monks. After restructuring and cleaning up several bugs, I have it working. However, the results are inconsistent. The entire screen is not captured every time it's run. I know that events and "main-line code" run asynchronously. What am I missing? In addition, is there a way to select a specific window among the many to capture. I had to force the example window to the top the get it captured. Otherwise the lower level windows get captured. Code listed below...

Thanks, James

#! /usr/bin/perl
#
# Capture Screen to a file. Written in wxPerl. Tested on Citrus Perl 5
+.16 and wxWidgets 2.8.x.
#
#           This is a hard coded example that needs to be generalized 
+into a package.
#
#           There seems to be a race condition between getting the sam
+ple written to the
#           screen and capturing the screen to the output file. Someti
+mes it captures an
#           incomplete screen. The sample screen does not paint smooth
+ly. It paints in two segments. Jerky.
#           It makes a difference where the Update and TakeScreenShot 
+calls
#           are placed(see comments below). Why????
#
# Reference: GetScreenShot C++ code page 139 of "The wxBook" -
#                  Cross-Platform GUI Programming with wxWidgets -
#                  Smart, Hock, and Csomor
#
# Original author: "PodMaster" from Perl Monks-2003 (no idea of real i
+dentity-not active for 6+ years)
#
# Modified by: James M. Lynes. Jr.
# Modified Date: October 17, 2012
#
#

use strict;
use warnings;

use lib '/home/pete/CitrusPerl/perl/vendor/lib/GD/Graph';
#where colour.pm is found in Citrus Perl distro
use Wx qw( :everything );
use colour qw( :everything );
use Wx::Event qw( EVT_PAINT );

#
# Main Application
#
my $app = Wx::SimpleApp->new;
my $frame = Wx::Frame->new(undef, -1, "Screen Capture", wxDefaultPosit
+ion,
wxDefaultSize , wxDEFAULT_FRAME_STYLE | wxMAXIMIZE | wxSTAY_ON_TOP);
EVT_PAINT( $frame, \&onPaint);
our $file = text_entry_dialog($frame);   # get the output filename
$frame->Show;
#$frame->Update;                                   # doesn't work to h
+ave
these calls in main loop????? why???
#TakeScreenshot($frame, $file);               # ditto - they must be i
+n onPaint sub???
$app->MainLoop;

#
# Copy the screen to the output file-similar to wxBook pg 139 example.
#
sub TakeScreenshot {
    my($self, $cfile ) = @_;

    my $screen = Wx::ScreenDC->new();
    my( $x, $y) = $screen->GetSizeWH();

    my $bitmap = Wx::Bitmap->new($x,$y,-1);

    my $memory = Wx::MemoryDC->new();
    $memory->SelectObject( $bitmap );
    $memory->Blit(0,0,$x,$y, $screen, 0, 0);                          
+   #
copy the screen to the bitmap
    $bitmap->SaveFile( $cfile , wxBITMAP_TYPE_BMP ) ;        # copy th
+e
bitmap to the output file
}

#
# Ask for the output filename
#
sub text_entry_dialog {
  my( $self ) = @_;
  my $dialog = Wx::TextEntryDialog->new
    ( $self, "Enter the Screen Capture output filename\n(Cancel will u
+se
the default filename shown below)\n",
      "Screen Capture File Entry",
      "capture.bmp", wxOK | wxCANCEL );
  my $textvalue = "capture.bmp";
  if( $dialog->ShowModal == wxID_OK ) {
      $textvalue = $dialog->GetValue;
  }
  $dialog->Destroy;
  return $textvalue;
}

#
# Generate the sample graphic screen to capture
#
sub onPaint{
    my($self,$event)=@_;

    my $screen = Wx::PaintDC->new($self);
    $screen->SetBackgroundMode( wxTRANSPARENT );
    $screen->SetFont(Wx::Font->new( 12, wxFONTFAMILY_ROMAN, wxNORMAL,
wxBOLD));

        for(0..17){
            my $c = $_ * 15;

                $screen->SetTextForeground( Wx::Colour->newRGB(0,0,$c)
+);
                $screen->DrawRotatedText("wxPerl",100 ,100 ,$c);
    }
                $screen->DrawRotatedText("wxPerl and PodMaster",000 ,4
+00
,0);
                $screen->DrawRotatedText("are messing up your screen",
+000
,450 ,0);

        for(0..17){
            my $c = $_ * 15;

                $screen->SetTextForeground( Wx::Colour->newRGB(0,$c,0)
+);
                $screen->DrawRotatedText("wxPerl",200 ,200 ,$c);
    }
                $screen->DrawRotatedText("wxPerl and PodMaster",100 ,5
+00
,0);
                $screen->DrawRotatedText("are messing up your screen",
+100
,550 ,0);

        for(0..17){
            my $c = $_ * 15;

                $screen->SetTextForeground( Wx::Colour->newRGB($c,0,0)
+);
                $screen->DrawRotatedText("wxPerl",300 ,300 ,$c);
    }
                $screen->DrawRotatedText("wxPerl and PodMaster",200 ,6
+00
,0);
                $screen->DrawRotatedText("are messing up your screen",
+200
,650 ,0);

$self->Update;                    # Force a screen repaint before capt
+ure
to make
                        # sure all items are written to the screen
TakeScreenshot($self, $file);            # Capture the screen
}

[download]
Update->Solved

Clipping and jerky screen painting was found to be caused by the frame being defined smaller(wxDefaultSize) than the sample graphic. Defining the frame to be (1024x768) cleans up the screen paint and captures the entire sample screen. Also the code flow now makes sense.

#! /usr/bin/perl
#
# Capture Screen to a file. Written in wxPerl. Tested on Citrus Perl 5
+.16 and wxWidgets 2.8.x.
#
#           This script draws and captures a sample graphic.
#        Take_Screenshot needs to be generalized into a package
#        that can be inserted into any application.
#
#        To capture the complete sample graphic, the frame size had to
+ be set to the screen size
#        of [1024x768]. Using wxDefaultSize caused the screen to paint
+ in two passes
#        and the capture to clip.
#
# Reference: GetScreenShot C++ code page 139 of "The wxBook" - 
#            Cross-Platform GUI Programming with wxWidgets - 
#            Smart, Hock, and Csomor
#
# Original author: "PodMaster" from Perl Monks-2003 (no idea of real i
+dentity-not active for 6+ years)
#
# Modified by: James M. Lynes. Jr.
# Last Modified Date: October 20, 2012
#
#
use strict;
use warnings;
use Wx qw(:everything);
use Wx::Event qw( EVT_PAINT );
#
# Main Application
#
my $app = Wx::SimpleApp->new;
my $frame = Wx::Frame->new(undef, -1, "Screen Capture Example", [0,0],
+ [1024,768] , wxDEFAULT_FRAME_STYLE);
EVT_PAINT( $frame, \&onPaint);
my $file = file_entry_dialog($frame);
$frame->Show;
Take_Screenshot($frame, $file);
$app->MainLoop;
#
# Generate a sample graphic screen to capture
#
sub onPaint{
    my($self,$event)=@_;
    my $screen = Wx::PaintDC->new($self);
    $screen->SetBackgroundMode( wxTRANSPARENT ); 
    $screen->SetFont(Wx::Font->new( 12, wxFONTFAMILY_ROMAN, wxNORMAL, 
+wxBOLD));

        for(0..17){
            my $c = $_ * 15;

                $screen->SetTextForeground( Wx::Colour->newRGB(0,0,$c)
+);
                $screen->DrawRotatedText("wxPerl",100 ,100 ,$c);
    }
                $screen->DrawRotatedText("wxPerl and PodMaster",000 ,4
+00 ,0);
                $screen->DrawRotatedText("are messing up your screen",
+000 ,450 ,0);

        for(0..17){
            my $c = $_ * 15;

                $screen->SetTextForeground( Wx::Colour->newRGB(0,$c,0)
+);
                $screen->DrawRotatedText("wxPerl",200 ,200 ,$c);
    }
                $screen->DrawRotatedText("wxPerl and PodMaster",100 ,5
+00 ,0);
                $screen->DrawRotatedText("are messing up your screen",
+100 ,550 ,0);

        for(0..17){
            my $c = $_ * 15;

                $screen->SetTextForeground( Wx::Colour->newRGB($c,0,0)
+);
                $screen->DrawRotatedText("wxPerl",300 ,300 ,$c);
    }
                $screen->DrawRotatedText("wxPerl and PodMaster",200 ,6
+00 ,0);
                $screen->DrawRotatedText("are messing up your screen",
+200 ,650 ,0);
}
#
# Copy the screen to the output file-similar to wxBook pg 139 example.
#
sub Take_Screenshot {
    my($self, $file ) = @_;
    $self->Refresh;                        # without Refresh and Updat
+e
    $self->Update;                        # the underlying window is c
+aptured
    my $screen = Wx::ScreenDC->new();
    my( $x, $y) = $screen->GetSizeWH();
    my $bitmap = Wx::Bitmap->new($x,$y,-1);
    my $memory = Wx::MemoryDC->new();
    $memory->SelectObject( $bitmap );
    $memory->Blit(0,0,$x,$y, $screen, 0, 0);            # copy the scr
+een to the bitmap
    $bitmap->SaveFile( $file , wxBITMAP_TYPE_BMP ) ;        # copy the
+ bitmap to the output file
}
#
# Ask for the output filename
#
sub file_entry_dialog {
  my( $self ) = @_;
  my $textvalue = "capture.bmp";
  my $dialog = Wx::TextEntryDialog->new
    ( $self, "Enter the Screen Capture output filename\n(Cancel will u
+se the default filename shown below)\n",
      "Screen Capture Output File Entry",
      $textvalue, wxOK | wxCANCEL );
  if( $dialog->ShowModal == wxID_OK ) {
      $textvalue = $dialog->GetValue;
  }
  $dialog->Destroy;
  return $textvalue;
}

[download]

In reply to Screen Capture via wxPerl Script by jmlynesjr

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 having an uproarious good time at the Monastery: (5)
As of 2024-04-22 22:53 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found