We help IT Professionals succeed at work.

Screen capture

winexec
winexec asked
on
Hello.

Here is an example of screen capture:

procedure GetDesktop;
var
   aDC,MemDC:HDC;
   hBmap,OldBitmap:HBitmap;
   bmp:TBitmap;
begin
   aDC:=GetDC(GetDesktopWindow);
   MemDC:=CreateCompatibleDC(aDC);
   hBmap:=CreateCompatibleBitmap(aDC,1024,768);
   OldBitmap:=SelectObject(MemDC,hBmap);
   BitBlt(MemDC,0,0,1024,768,ADC,0,0,SRCCOPY);
   SelectObject(MemDC,OldBitmap);
   bmp:=TBitmap.Create;
   bmp.Handle:=hbmap;
   bmp.SaveToFile('c:\screen.bmp');
   bmp.Free;
   DeleteDC(MemDC);
   ReleaseDC(GetDesktopWindow,aDC);
end;

The code is OK, the only problem being that I don't want to use the Graphix unit. The TBitmap wich I used belongs to Graphix and all I need is to save the screenshot without using that unit.

Anyone can help me?

Thanks,
Winexec
Comment
Watch Question

Commented:
you could copy the code out of TBitmap.WriteStream.

Here it is...
This code uses the TCanvas but that is easy enough to remove.

procedure TBitmap.WriteStream(Stream: TStream; WriteSize: Boolean);
const
  PalSize: array [Boolean] of Byte = (sizeof(TRGBQuad), sizeof(TRGBTriple));
var
  Size, ColorCount: DWORD;
  HeaderSize: DWORD;
  BMF: TBitmapFileHeader;
  Save: THandle;
  BC: TBitmapCoreHeader;
  Colors: array [Byte] of TRGBQuad;
begin
  FillChar(BMF, sizeof(BMF), 0);
  BMF.bfType := $4D42;
  if FImage.FSaveStream <> nil then
  begin
    Size := FImage.FSaveStream.Size;
    if WriteSize then
      Stream.WriteBuffer(Size, sizeof(Size));
    Stream.Write(FImage.FSaveStream.Memory^, FImage.FSaveStream.Size);
    Exit;
  end;
  DIBNeeded;
  with FImage do
  begin
    Size := 0;
    if FDIBHandle <> 0 then
    begin
      InternalGetDIBSizes(FDIBHandle, HeaderSize, Size, FDIB.dsbmih.biClrUsed);
      if FOS2Format then
      begin // OS2 format cannot have partial palette
        HeaderSize := sizeof(BC);
        if FDIB.dsbmih.biBitCount <= 8 then
          Inc(HeaderSize, sizeof(TRGBTriple) * (1 shl FDIB.dsbmih.biBitCount));
      end;
      Inc(Size, HeaderSize + sizeof(BMF));

      FillChar(BMF, sizeof(BMF), 0);
      BMF.bfType := $4D42;

      Canvas.RequiredState([csHandleValid]);
      Save := GDICheck(SelectObject(FCanvas.FHandle, FDIBHandle));
      ColorCount := GetDIBColorTable(FCanvas.FHandle, 0, 256, Colors);
      SelectObject(FCanvas.FHandle, Save);
      // GetDIBColorTable always reports the full palette; trim it back for partial palettes
      if (0 < FDIB.dsbmih.biClrUsed) and (FDIB.dsbmih.biClrUsed < ColorCount) then
        ColorCount := FDIB.dsbmih.biClrUsed;
      if (not FOS2Format) and (ColorCount = 0) and (FPalette <> 0) and not FHalftone then
      begin
        ColorCount := PaletteToDIBColorTable(FPalette, Colors);
        if FDIB.dsbmih.biBitCount > 8 then
        begin  // optional color palette for hicolor images (non OS2)
          Inc(Size, ColorCount * sizeof(TRGBQuad));
          Inc(HeaderSize, ColorCount * sizeof(TRGBQuad));
        end;
      end;

      BMF.bfSize := Size;
      BMF.bfOffBits := sizeof(BMF) + HeaderSize;
    end;

    if WriteSize then Stream.WriteBuffer(Size, SizeOf(Size));

    if Size <> 0 then
    begin
      FixupBitFields(FDIB);
      if (ColorCount <> 0) then
      begin
        if (FDIB.dsbmih.biClrUsed = 0) or (FDIB.dsbmih.biClrUsed <> ColorCount) then
          FDIB.dsbmih.biClrUsed := ColorCount;
        if FOS2Format then RGBQuadToTriple(Colors, Integer(ColorCount));
      end;
      if FOS2Format then
      begin
        with BC, FDIB.dsbmih do
        begin
          bcSize := sizeof(BC);
          bcWidth := biWidth;
          bcHeight := biHeight;
          bcPlanes := 1;
          bcBitCount := biBitCount;
        end;
        Stream.WriteBuffer(BMF, sizeof(BMF));
        Stream.WriteBuffer(BC, sizeof(BC));
      end
      else
      begin
        Stream.WriteBuffer(BMF, Sizeof(BMF));
        Stream.WriteBuffer(FDIB.dsbmih, Sizeof(FDIB.dsbmih));
        if (FDIB.dsbmih.biBitCount > 8) and
          ((FDIB.dsbmih.biCompression and BI_BITFIELDS) <> 0) then
          Stream.WriteBuffer(FDIB.dsBitfields, 12);
      end;
      Stream.WriteBuffer(Colors, ColorCount * PalSize[FOS2Format]);
      Stream.WriteBuffer(FDIB.dsbm.bmBits^, FDIB.dsbmih.biSizeImage);
    end;
  end;
end;

Author

Commented:
Thx for response Robn, but doesn't help me.

Sorry cause I didn't specify more clear my problem: I want to use only Windows unit, and not Graphics, Classes (which is used in your sample) etc.

Commented:
You can use CreateFile and GetMem instead of a stream. Manage canvas handles, Palettes, brushes, etc yourself (without using the Delphi units). I was just showing the algorithm used to save a bitmap image. It would come in handy when you re-write it to use only API method calls.
It would be a lot of work though. If I was doing it, I would write a DLL that would take in a bitmap handle and filename and save that to file.

Author

Commented:
Yes, thx, I know I can use GetMem, CreateFile etc. in the place of the Classes stream, but I'm not so advanced to do it. Also, I have to get rid of Canvas... Seems pretty hard for me...

Hm, I didn't think it's so hard :( Can you Robn gimme an example (if you had one)? Or anybody else?

I increased the points to 300, but I need a sample.

Thx.
OK, let me try ;-)

procedure TForm1.Button1Click(Sender: TObject);
var
  hdcScreen,hdcCompatible: hdc;
  hbmScreen:Hbitmap;
begin
  hdcScreen := CreateDC('DISPLAY', nil, nil, nil);
  hdcCompatible:=CreateCompatibleDC(hdcScreen);
  hbmScreen:= CreateCompatibleBitmap(hdcScreen,
     GetDeviceCaps(hdcScreen, HORZRES),
     GetDeviceCaps(hdcScreen, VERTRES));
  SelectObject(hdcCompatible, hbmScreen);
  BitBlt(hdcCompatible,0,0,GetDeviceCaps(hdcScreen, HORZRES),
      GetDeviceCaps(hdcScreen, VERTRES),hdcScreen,
      0,0,SRCCOPY);

  // Additional code, uses Clipbrd unit
  OpenClipboard(Handle);
  EmptyClipboard;
  SetClipboardData(CF_BITMAP,hbmScreen);
  CloseClipboard;

  DeleteObject(hbmScreen);
  DeleteDC(hdcCompatible);
  DeleteDC(hdcScreen);
end;

Screen is stored in hbmScreen variable of HBitmap.
This code uses Windows unit only, as wanted.
hello winexec, you have requested one of the more confusing operations of the windows API, write a Bitmap to file. . . I will not attempt to explain much of what this is doing. . . In your code you do this

OldBitmap:=SelectObject(MemDC,hBmap);

but there is NO OldBitmap, it is ZERO. . . nothing,  so that is uneeded code


So here is some code for a button click, that Only uses windows API to get a screen image and write it to file - - - - -




procedure TForm1.sbut_Bmp2FileAPIClick(Sender: TObject);
var
BmpDC, hBmpBG, ScreenDC, hFile1, BytesWrite: Cardinal;
BitC: Integer;
BitInfo1: TBitmapInfo;
BFH1: TBitmapFileHeader;
Pbits: pointer;
PalColors: array[Byte] of TRGBQuad;
begin
BmpDC := CreateCompatibleDC(0);
{get a DC like the Screen Has}
BitC := GetDeviceCaps(BmpDC, BITSPIXEL);
if BitC < 8 then
BitC := 24;
{the GetDeviceCaps gets the Display color depth, since you used the
CreateCompatibleBitmap, I just guess that you want a Bitmap File with
the same color stuff as the Screen}

PBits := nil;
ZeroMemory(@BitInfo1, sizeOf(BitInfo1));

{You use a Device Dependent Bitmap from CreateCompatibleBitmap, but a Bitmap
file needs to be Device Independent, It would be useless to create a Bitmap
with CreateCompatibleBitmap, because you would still need to create a
DIB with CreateDIBSection or convert the DDB to DIB another way
I Just create A DIB and save it to file}
with BitInfo1.bmiHeader do
  begin
  biSize := sizeOf(BitInfo1.bmiHeader);
  biBitCount    := BitC;
{you can set the biBitCount to the color depth you need as a value of
1, 4, 8, 16, 24, or 32,
WARNING but if you use 1 or 4, you will need to change the
formular for biSizeImage := (biWidth * (BitC div 8)) * biHeight}
  biCompression := BI_RGB;
  biPlanes := 1;
  biWidth := GetSystemMetrics(SM_CXSCREEN);
  biHeight := GetSystemMetrics(SM_CYSCREEN);
  biSizeImage := (biWidth * (BitC div 8)) * biHeight;
  end;
{the CreateDIBSection needs the info in the BitInfo1 to make a Device
Independent Bitmap}
hBmpBG := CreateDIBSection(BmpDC, BitInfo1, DIB_RGB_COLORS, Pbits, 0, 0);

SelectObject(BmpDC, hBmpBG);

{if the color Depth is 8 bit then you will need to get the Palette}
if BitC = 8 then
  begin
  BitInfo1.bmiHeader.biClrUsed := 256;
  GetDIBColorTable(BmpDC, 0, 255, PalColors);
  end else
  BitInfo1.bmiHeader.biClrUsed := 0;

ScreenDC := GetDC(0);
BitBlt(BmpDC,0,0, BitInfo1.bmiHeader.biWidth,
       BitInfo1.bmiHeader.biHeight, ScreenDC,0,0,SRCCOPY);
{this copies the screen to the bitmap}
DeleteDC(BmpDC);
ReleaseDC(0, ScreenDC);

ZeroMemory(@BFH1, sizeOf(BFH1));
{start building your Bitmap file with the Bitmap File Header}
BFH1.bfType := $4D42;  // ASCII for 'BM'
BFH1.bfOffBits := sizeof(BFH1)+BitInfo1.bmiHeader.biSize+
                  (BitInfo1.bmiHeader.biClrUsed * SizeOf(TRGBQUAD));
BFH1.bfSize := BFH1.bfOffBits + BitInfo1.bmiHeader.biSizeImage;

{create an API File}
hFile1 := CreateFile('E:\DIBmp1.bmp',GENERIC_WRITE,FILE_SHARE_READ, nil,
          CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN, 0);
if hFile1 <> INVALID_HANDLE_VALUE then
  begin
  {you should include some tests here to see if the file parts are written
  but I did not do that to make this a little less complex}
  WriteFile(hFile1,BFH1, SizeOf(BFH1), BytesWrite, nil);
{write BMP file header}
  WriteFile(hFile1, BitInfo1.bmiHeader, SizeOf(BitInfo1.bmiHeader), BytesWrite, nil);
{write Bmp Info Header}
  if BitInfo1.bmiHeader.biClrUsed > 0 then
  WriteFile(hFile1,PalColors, BitInfo1.bmiHeader.biClrUsed * SizeOf(TRGBQUAD), BytesWrite, nil);
{write Palette color defintions if there are biClrUsed}
  WriteFile(hFile1, Pbits^, BitInfo1.bmiHeader.biSizeImage, BytesWrite, nil);
{write Pixel color Bits defintions in the Pointer Pbits}
  CloseHandle(hFile1);
  end;
DeleteObject(hBmpBG);
{you can NOT deleteObject your bitmap until After the Pbits are written to file}
end;

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -  - - -

Good luck with trying to understand the API bitmap methods

ask questions if you need more info
OK, I tried to hard to simplify this, and gave a formular that less code, but is not as it needs to be, you should change the line

biSizeImage := (biWidth * (BitC div 8)) * biHeight;

to these Two lines -

  biSizeImage := ((biWidth * biBitCount) + 31) and not 31;
  biSizeImage := Integer(biSizeImage div 8) * biHeight;


this will make sure each scan line (width) is DWORD aligned

Author

Commented:
Thx a lot Slick812, that's what I wanted :)

One more thing I need to know (out of that question, if you could help): what could be done to retrieve a black&white screenshot ?
????

I am not sure what you are asking about the black&white screenshot. . . There's more to a Graphic than just calling it black&white

so I do not have any Idea what you may mean,
I true black&white is in 1 bit color depth. . . however, that is never worth doing for a Full color monitor

You probaly mean "GreyScale". . . bot there are 4 bit, 8 bit and Full color greyscale. . .

and that's something for a whole NEW question, since it ain't so easy