Hi
I was finally able to do what i wanted: Screen Capture using GUITest then
use the BMP data from GetBitmap
into TK.
The problem was simply the way GetBitmap produces the BMP data. Below is the
routine
ShowLocation(Xcoor,Ycoor) which will capture a 120x40 screen centered around
(Xcoor,Ycoor) inputs.
and then show that portion in this widget: $frames{XX}->configure( -image
=> 'image1' );
There are two format problems with the GetBitmap:
#1 $header .= pack "L", 0; #1Eh 4 0
BI_RGB, No compression used
This data should be zero; but Getbitmap returns a non zero (compressed
bitmap format) that is not acceptable to TK.
#2. $header .= pack "S", 24; #1Ch 2 24 bits The
number of bits/pixel.
This data should be 24 bits - 8 bits per color x 3 color pixels. GetBitmap
used 32 bits...
There is one problem I also encountered which is basically a Perl version
issue.
For whatever reason, GUITest::SendKeys and Clipboard::GetBitmap does not
work properly on some
Perl built.. Though I had the latest 5.8 perl built, i had to revert back to
an older 5.8 [822] by simply
copying all the [822] files over the new 5.8 perl.
SendKeys('{PRTSCR}');
usleep (1+$DELAY)*1000;
my $screen = $CLIP->GetBitmap();
The problem i encounter is that, by Sending SendKeys, Getbitmap isnt getting
any data!
Very very wierd. My solution was to stick with an older Perl.
Dan
sub ShowLocation {
# return;
my ($X,$Y) = @_;
my ($w,$h) = (60,20);
SendKeys('{PRTSCR}');
usleep (1+$DELAY)*1000;
my $screen = $CLIP->GetBitmap();
if ($screen eq '') {
print "ERROR: NO bitmap\n";
return;
}
#We only need these 4 info to decipher a BMP File
my $offset = unpack "L", substr($screen,0x0A,4);
my $width = unpack "L", substr($screen,0x12,4);
my $height = unpack "L", substr($screen,0x16,4);
my $pixels = unpack "S", substr($screen,0x1C,2);
my $byte = $pixels / 8;
$Y = $height - $Y;
my $x0 = $X - $w; $x0 = 0 if $x0<0;
my $x1 = $X + $w; $x1 = $width if $x1>$width;
my $y0 = $Y - $h; $y0 = 0 if $y0<0;
my $y1 = $Y + $h; $y1 = $height if $y1>$height;
my ($header,$data);
for (my $y=$y0; $y<=$y1; $y++) {
my $index = $offset + $y*$width*$byte;
my $temp = '';
for (my $x=$index+$x0*$byte; $x<=$index+$x1*$byte; $x+=$byte) {
$temp .= substr($screen, $x, 3);
}
if (length($temp)%4>0) {
$temp .= substr('****',0,4-length($temp)%4);
}
#$temp = substr($screen,$index, (1+$x1-$x0)*$byte);
$data .= $temp;
}
$header = "BM"; #00h 2 "BM" Magic Number
(unsigned integer 66, 77)
$header .= pack "L", 54+length($data); #02h 4 File Size in
Bytes Size of the BMP file
$header .= pack "S", 0; #06h 2 Unused
Application Specific
$header .= pack "S", 0; #08h 2 Unused
Application Specific
$header .= pack "L", 54; #0Ah 4 54 bytes The
offset where the bitmap data (pixels) can be found.
$header .= pack "L", 40; #0Eh 4 40 bytes The
number of bytes in the header (from this point).
$header .= pack "L", 1+$x1-$x0; #12h 4 2 pixels
The width of the bitmap in pixels
$header .= pack "L", 1+$y1-$y0; #16h 4 2 pixels
The height of the bitmap in pixels
$header .= pack "S", 1; #1Ah 2 1 plane Number
of color planes being used.
$header .= pack "S", 24; #1Ch 2 24 bits The
number of bits/pixel.
$header .= pack "L", 0; #1Eh 4 0 BI_RGB,
No compression used
$header .= pack "L", length($data); #22h 4 bytes
The size of the raw BMP data (after this header)
$header .= pack "L", 0; #26h 4 0 pixels/meter
The horizontal resolution of the image
$header .= pack "L", 0; #2Ah 4 0 pixels/meter
The vertical resolution of the image
$header .= pack "L", 0; #2Eh 4 0 colors
Number of colors in the palette
$header .= pack "L", 0; #32h 4 0 important colors
Means all colors are important
open DFILE, ">_temp.bmp";
binmode DFILE;
print DFILE $header.$data;
close DFILE;
# my $bitmap = $header . $data;
# $mw->Photo('image1', -data => oct(\$bitmap), -format=>"bmp");
$mw->Photo('image1', -file => "_temp.bmp" , -format=>"bmp");
$frames{XX}->configure( -image => 'image1' );
unlink "_temp.bmp";
}
On Wed, Dec 2, 2009 at 12:26 AM, Glenn Linderman <[email protected]> wrote:
> Hi Dan,
>
> Any success here?
>
> I'd suggest using IrfanView for testing, in addition to MSPhotoEdit,
> although since BMP is a MS-proprietary format, their software should
> understand it, I wouldn't trust MSPhotoEdit to conform to industry standard
> formats.
>
> On approximately 11/23/2009 11:37 PM, came the following characters from
> the keyboard of Daniel Burgaud:
>
>> Hi
>>
>> Unfortunately, this method was for Linux only.. not for Win32...
>>
>> Fortunately I managed to dig out the bug. It turns out that the BMP
>> produced
>> by Win32::Clipboard::GetBitmap is simply not compatible to TK.
>>
>> The BMP file created by Win32::Clipboard::GetBitmap is not even compatible
>> with MSPhotoEdit. So I tried to create a BMP file with MSPhotoEdit and
>> that
>> file was acceptable to TK. ..
>>
>> Now I know what to do next... I'll play around this file and see what is
>> difference
>> it has over Win32::Clipboard::GetBitmap format...
>>
>> Dan
>>
>> On Mon, Nov 23, 2009 at 4:19 PM, Glenn Linderman <[email protected]<mailto:
>> [email protected]>> wrote:
>>
>> On approximately 11/22/2009 11:48 PM, came the following
>> characters from the keyboard of Daniel Burgaud:
>>
>> Hi,
>>
>> Does TK have image Crop functionality?
>>
>> The reason why I wanted to use BMP is it's simple format..
>> What I need in my final code is to show in a small "label
>> widget" a small portion of the screen
>> where the mouse was when ButtonRelease-1 was issued. BMP
>> cropping is easy to accomplish
>> with perl.
>>
>>
>> The reference I gave (and I'm not much of a Tk user, so just found
>> it using Google), seems to talk about how Tk can capture even a
>> single widget from the screen... but maybe that only applies to
>> things placed there by Tk, maybe you are capturing something from
>> another program. Anyway, good luck on achieving your goals.
>>
>>
>> http://www.perlmonks.org/index.pl?node_id=361299 describes one
>> way, dunno if it can be ported to Windows or not.
>>
>>
>>
>>
> --
> Glenn
> ------------------------------------------------------------------------
> “Everyone is entitled to their own opinion, but not their own facts. In
> turn, everyone is entitled to their own opinions of the facts, but not their
> own facts based on their opinions.” -- Guy Rocha, retiring NV state
> archivist
>
_______________________________________________
Perl-Win32-Users mailing list
[email protected]
To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs
