Problem with SendKeys, Clipboard and Tk

[Daniel Burgaud]

HI

I am experiencing a bug with SendKeys, Clipboard and Tk:

###############################################
#FILE: x.pl
use strict;
use Win32::GuiTest qw(SendKeys);
use Win32::Clipboard;
Win32::Clipboard->Empty();

sub CaptureScreen {
    SendKeys('{PRTSCR}');
    my $screen = Win32::Clipboard::GetBitmap();
    open DFILE, ">x.bmp";
    binmode DFILE;
    print DFILE $screen;
    close DFILE;
}
CaptureScreen();
##############################################
Above is a simple Screen Capture using SendKeys and Clipboard.
It saves the captured screen to a file called x.bmp.
I find no problem with this script.




Now here is the problem:
##############################################################################
use strict;
use Time::HiRes qw(time usleep);
use Win32::GuiTest qw(GetCursorPos SendKeys);
use Win32::Clipboard;
Win32::Clipboard->Empty();

use Tk;

my $mw = MainWindow->new( -bg => "#F0F0F0" );
my %frames;
$mw->minsize(250,300);
$mw->maxsize(250,300);

$frames{'B'}        = $mw->Frame( -borderwidth => 0, )->pack( -side =>
'left',   -expand => 0, -fill => 'y', );
    $frames{'B.LR'}    = $frames{'B'}->Label( -text=>'Capture',  )->pack(
-side=>"top",  -expand=>1, -fill=>'both', );
    BINDER(\$frames{'B.LR'});

sub BINDER {
    my $x = shift;
    $$x->bind('<ButtonPress-1>'  => sub{ $$x->configure(-cursor=>'dot',
-relief=>'raised', -fg=>"Yellow", -font=>['Arial',12,'normal'] );
$mw->update(); });
    $$x->bind('<ButtonRelease-1>'=> sub{ $$x->configure(-cursor=>'arrow',
-relief=>'groove', -fg=>'Yellow', -font=>['Arial',12,'bold'  ]);
CaptureScreen(); $mw->update(); });
    $$x->bind('<ButtonPress-3>'  => sub{ $$x->configure(-cursor=>'arrow',
-relief=>'sunken', -fg=>"Black",  -font=>['Arial',12,'normal']);
$mw->update(); });

}

sub CaptureScreen {
    SendKeys('{PRTSCR}');
    my $screen = Win32::Clipboard::GetBitmap();
    open DFILE, ">y.bmp";
    binmode DFILE;
    print DFILE $screen;
    close DFILE;
}

while (1) {
    $mw->update();
    usleep(5000);
}
##############################################################################

I added a simple Tk Window and a Label wherein you can "ButtonRelease-1" to
initiate capturing the screen.
This one does not work. It captures nothing and saves a blank file "y.bmp".

Any idea why and how to solve thsi problem?

Dan

_______________________________________________
Perl-Win32-Users mailing list
Perl-Win32-Users@listserv.ActiveState.com
To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs