michbach has asked for the wisdom of the Perl Monks concerning the following question:

Hi all, does anybody know a faster way to grab the color of the pixels of the desktop? At the momen i use GetPixel (see the code-example) but its really too slow for greater sections!! I know in C++ you can create DIB-Sections and then u have a very fast direct access. Sure, i know Perl is not a the first adress to manipulate pixels but may be there is in Perl also a possibility?? May anybody has already a good understanding code-snippet or a good tip? It would be very fine, thanks a lot for any help!! 
...
my $a = 800;  # width
my $b = 600;  # height
my $desktop = new Win32::GUI::DC("DISPLAY");

foreach $x (1..$a)
{
  foreach $y (1..$b)
  {
    $pix = $desktop -> GetPixel ($x, $y);
    .... make something with that pix
  }
}

[download]
best regards, michbach

Replies are listed 'Best First'.
Re: Alternate for GetPixel
by almut (Canon) on Mar 08, 2009 at 13:41 UTC

    Maybe you can use Win32::GUI::DIBitmap (in particular newFromDC(...)), instead of making a separate call for every single pixel... — Sounds like it might do what you want (can't try it myself at the moment, no Windows box within reach).

[reply]
[d/l]
      Hi almut, that looks good on the first fly! Now i have to study how to use it. Thanks!!!

      Update:
      Hi almut! I tried to find a faster way with Win32::GUI::DIBitmap but without success! There is also the same slow function getpixel. I have read in another forum following about getpixel:
      "..but what do you thing GetPixel() is doing internally? Each time you call it, it must first read the header, get the bits, calculate the size of a pixel, calculate the the size of a row, calculate which row, calculate how far into that row, get the pixel, convert it to a COLORREF then give it back to you. ALL FOR ONE PIXEL! This is for every single call. Use a DIB and access the bits directly ....."

      I guess i need an access directly to the memory-adresses to get the information of the pixels faster.. But i dont know how i can make it :-(

      best regards, michbach
[reply]
        I tried to find a faster way with Win32::GUI::DIBitmap but without success!

        What exactly have you tried (could you post the code)?  How did it fail (error message, wrong result (if so, which?), ...)?

        (sorry for the late reply — hadn't seen the update before this moment)

[reply]
Re: Alternate for GetPixel
by zentara (Cardinal) on Mar 08, 2009 at 14:06 UTC
    I saw ( can't remember where) a little c utility that did precisely that. You might google for it. It did a global_grab of the desktop, and made the mouse an eye-drop icon, then let you click on a pixel. For code, look at any screen capture program, and figure out the mouse bindings needed to get pixel value at that position. The screen capture is already capturing all pixels, so printing them out shouldn't be too hard. GD, Imager and ImageMagick all have some mechanism to dump ALL pixels, or pixels at a known point.
    I'm not really a human, but I play one on earth My Petition to the Great Cosmic Conciousness
[reply]
      Hi zentara, thanks a lot for your help. If i have no success with Win32::GUI::DIBitmap i will google for the utility what u have sawn.. regards, michbach
[reply]
Re: Alternate for GetPixel
by Beechbone (Friar) on Mar 10, 2009 at 10:22 UTC
    I use this in one of my programs to read parts of the screen. It's not Perl but Pascal, but you should be able to adapt it, I hope.

    procedure TForm1.ScreenShot(wnd: HWND; x : integer; y : integer; Width
+ : integer; Height : integer; bm : TBitMap);
var
  dc: HDC; lpPal : PLOGPALETTE;
begin
{test width and height}
  if ((Width = 0) OR (Height = 0)) then exit;
  bm.Width := Width;
  bm.Height := Height;
{get the screen dc}
  dc := GetDc(wnd);
  if (dc = 0) then exit;
{do we have a palette device?}
  if (GetDeviceCaps(dc, RASTERCAPS) AND RC_PALETTE = RC_PALETTE) then
  begin
    {allocate memory for a logical palette}
    GetMem(lpPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)))
+;
    {zero it out to be neat}
    FillChar(lpPal^, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY
+)), #0);
    {fill in the palette version}
    lpPal^.palVersion := $300;
    {grab the system palette entries}
    lpPal^.palNumEntries :=GetSystemPaletteEntries(dc,0,256,lpPal^.pal
+PalEntry);
    if (lpPal^.PalNumEntries <> 0) then
    begin
      {create the palette}
      bm.Palette := CreatePalette(lpPal^);
    end;
    FreeMem(lpPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY))
+);
  end;
  {copy from the screen to the bitmap}
  BitBlt(bm.Canvas.Handle,0,0,Width,Height,Dc,x,y,SRCCOPY);
  {release the screen dc}
  ReleaseDc(wnd, dc);
end; (* ScreenShot *)

    [download]
    BTW: I think you can ignore the (lengthy) part about palettes, unless you want/need your program to work with 256-color display modes. That'd shorten it to: 
    procedure TForm1.ScreenShot2(wnd: HWND; x : integer; y : integer; Widt
+h : integer; Height : integer; bm : TBitMap);
var
  dc: HDC;
begin
  {test width and height}
  if ((Width = 0) OR (Height = 0)) then exit;
  bm.Width := Width;
  bm.Height := Height;
  {get the screen dc}
  dc := GetDc(wnd);
  if (dc = 0) then exit;
  {copy from the screen to the bitmap}
  BitBlt(bm.Canvas.Handle,0,0,Width,Height,Dc,x,y,SRCCOPY);
  {release the screen dc}
  ReleaseDc(wnd, dc);
end; (* ScreenShot *)

    [download]
    Search, Ask, Know
[reply]
[d/l]
[select]

Back to Seekers of Perl Wisdom