We help IT Professionals succeed at work.

Taking a 24bit screen shot

_lr_
_lr_ asked
on
I made this function to get a screen shot the only problem is that I need to
get the screenshot in 24bits, the way the funcion is desinged write now it
gets the screenshot in the device resolution. What changes do i need to make
so that i get a 24bits screen shot??
I think it should be easy to make this but since I'm new to API programming
i have no idea how to do this.

Thanks.

//MY CODE

type TImgHandles = record
        DC: HDC;
        BM: HBITMAP;
        Palette: HPALETTE;
        Width, Height: Integer;
     end;

function ScreenShot_HDC: TImgHandles;
var
   ScreenDC, ResultDC: HDC;
   lpPal : PLOGPALETTE;
   DesktopHandle: HWND;
   Rect: TRect;
   bm: HBitmap;
   width, height: integer;
   palete: HPALETTE;
begin
     {get the screen dc}
     DesktopHandle := GetDesktopWindow ( );
     ScreenDC := GetDc(DesktopHandle);
    // ScreenDC := GetDC(0);
     GetWindowRect ( DesktopHandle, Rect );
     if (ScreenDC = 0) then exit;

     width := Rect.Right-Rect.Left;
     height := Rect.Bottom-Rect.Top;
     bm := CreateCompatibleBitmap(ScreenDC, width, height);

     ResultDC := CreateCompatibleDC(ScreenDC);

     {do we have a palette device?}
     if (GetDeviceCaps(ScreenDC, 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(ScreenDC, 0, 256,
lpPal^.palPalEntry);
        if (lpPal^.PalNumEntries <> 0) then begin
          {create the palette}
          palete :=  CreatePalette(lpPal^);
          SelectPalette(bm, palete, false);
        end;
        FreeMem(lpPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
     end;

     SelectObject(ResultDC, bm);
     {copy from the screen dc to the bitmap dc}
     BitBlt(ResultDC, 0, 0, Width ,Height, ScreenDC, 0, 0, SRCCOPY);
     {release the screen dc and and desktop dc}
     ReleaseDC(DesktopHandle, ScreenDC);

     {return the dc that has the screenshot}
     result.DC := ResultDC;
     Result.BM := bm;
     Result.Palette := palete;
     Result.Width := Width;
     Result.Height := Height;
end;


Comment
Watch Question

Commented:
Use a TBitmap instead and set its PixelFormat property to pf24bit.


Good luck!!


 
Commented:
yeah, delphi offers you a lot of functionality to make this easier, here's my version:

var
 screenShot : TBitmap;
 dc : HDC;
begin
 screenShot := TBitmap.create;
 with screenShot do
 begin
  pixelFormat := pf24bit;
  width := screen.wdith;
  height := screen.height;
 end;
 dc := getDC(getDeskTopWindow);
 biblt(
  screenShot.canvas.handle,
  0,0,screen.width,screen.height,
  dc,
  0,0,
  SRCCOPY);
 releaseDC(getDeskTopWindow,dc);


GL
Mike

ps, please consider this a mere footnote to DrDelphi's comment.
Hmm... footnote that is *much* longer than the original comment... *grin*

:)

Author

Commented:
The problem is that using a delphi TBitmap is more or less 50x slower on my test pc, using the API is a lot fast. So I need a solution using the API.

Commented:
Listening...

Commented:
In that case, us createDIBSection instead of  createCompatibleBitmap. Though I'd be worried if it's much faster then my example as there really isn't much difference, TBitmap is a pretty thin wrapper.  Perhaps most of the difference amy be in creating the bmp, in that case you might not want to keep recreating it.  I guess my point is that the bottleneck shouldn't be in the code posted here, both versions should be quite fast, though there may be other bits to look at.

GL
Mike

Author

Commented:
I really don't know how to use createDIBSection and dont't understant the doc's in the windows programmers refrence, could you please give me some source.

The bottleneck isn't on the code posted here this onde works fine and is very fast, the problem is on the other code i have that uses a tbimap to take a screen shot, that one some times is 50x slower than this one.

Commented:
I guess my concern is that the meat of our code:

BitBlt(ResultDC, 0, 0, Width ,Height, ScreenDC, 0, 0, SRCCOPY);

and:

biblt(
 screenShot.canvas.handle,
 0,0,screen.width,screen.height,
 dc,
 0,0,
 SRCCOPY);

do exactly the same thing. The only realy difference between our examples is how the the bitmap is created, and even then there isn't much difference as TBitmap has to do the same stuff anyways.

I tried the following code on my crusty office pc (P266) and got a values of 20.4, 20.7 & 20.9 seconds, or about 5 complete screenshots (inc. all bmp & hdc create's & destroys) per second.  If I took the creation/destroy code out of the loop I got scores of 17.3-17.7. blitting to a bitmap created with createCompatibleBitmap (again, create/destroy _out_ of the loop) I got values of 17.1-17.7. It's possible I may be wrong, it's been known to happen :), but I would think that 50x slowdown has to be coming from somewhere else.

procedure TForm1.Button1Click(Sender: TObject);
var
   dc : HDC;
   bmp : TBitmap;
   ix : integer;
   start : TDateTime;
begin
     start := now;
     for ix := 0 to 100 do
     begin
          bmp := TBitmap.create;
          bmp.pixelFormat := pf24bit;
          bmp.width := screen.width;
          bmp.height := screen.height;
          dc := getDC(getDeskTopWindow);
          bitblt(
                 bmp.canvas.handle,
                 0,0,screen.width,screen.height,
                 dc,
                 0,0,
                 SRCCOPY);
          releaseDC(getDeskTopWindow,dc);
          bmp.free;
     end;
     caption := floatToStr((now-start)*(24*3600));
end;

GL
Mike

Commented:
I have to agree with Mike. I ,too have tested both and have found that they are almost identical in terms of execution time (although my times are slightly lower...faster machine<g>)

-DrD

Author

Commented:
I'm using
QueryPerformanceFrequency(c);
QueryPerformanceCounter(n1);
...
QueryPerformanceCounter(n2);

To test the real speed of execution the other screenshot code is this:

procedure ScreenShot(var bm : TBitMap);
var
   dc: HDC;
   lpPal : PLOGPALETTE;
   Handles: HWND;
   Rect: TRect;
begin
{get the screen dc}
Handles := GetDesktopWindow ( );
dc := GetDc(Handles);
GetWindowRect ( Handles, Rect );
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^.palPalEntry);
   if (lpPal^.PalNumEntries <> 0) then begin
       {create the palette}
       bm.Palette := CreatePalette(lpPal^);
   end;
   FreeMem(lpPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
end;

bm.Width := Rect.Right - Rect.Left;
bm.Height := Rect.Bottom - Rect.Top;

{copy from the screen to the bitmap}
BitBlt(bm.Canvas.Handle, 0, 0, bm.Width ,bm.Height, Dc, 0, 0, SRCCOPY);
{release the screen dc}
ReleaseDc(Handles , dc);
end;



On my test machine, the API screen shot takes 0,004xxx sec and this version using tbitmap takes 0.2xx (not counting the time that takes to create a bitmap, with is really fast - just some milesims of a sec.).

Is any of you have any ideias why the API  version is so much faster let me know.

Explore More ContentExplore courses, solutions, and other research materials related to this topic.