whats new ¦  programming tips ¦  indy articles ¦  intraweb articles ¦  informations ¦  links ¦  interviews
 misc ¦  tutorials ¦  Add&Win Game

Tips (1548)

Database (90)
Files (137)
Forms (107)
Graphic (116)
IDE (21)
Indy (5)
Internet / LAN (131)
IntraWeb (0)
Math (76)
Misc (127)
Multimedia (45)
Objects/
ActiveX (51)

OpenTools API (3)
Printing (35)
Strings (83)
System (268)
VCL (243)

Top15

Tips sort by
component


Search Tip

Add new Tip

Add&Win Game

Advertising

36 Visitors Online


 
...make a desktop screenshot?
Autor: Simon Grossenbacher
Homepage: http://www.swissdelphicenter.ch
[ Print tip ]  

Tip Rating (25):  
     


{---------------------1---------------------}
function GetScreenShot: TBitmap;
var
  
Desktop: HDC;
begin
  
Result  := TBitmap.Create;
  Desktop := GetDC(0);
  try
    try
      
Result.PixelFormat := pf32bit;
      Result.Width := Screen.Width;
      Result.Height := Screen.Height;
      BitBlt(Result.Canvas.Handle, 0, 0, Result.Width, Result.Height, Desktop, 0, 0, SRCCOPY);
      Result.Modified := True;
    finally
      
ReleaseDC(0, Desktop);
    end;
  except
    
Result.Free;
    Result := nil;
  end;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  
Image1.Picture.Bitmap := GetScreenShot;
end;


{---------------------2---------------------}
procedure TForm1.Button1Click(Sender: TObject);
var DCDesk: HDC; // hDC of Desktop
  
bmp: TBitmap;
begin
  
{Create a bitmap}
  
bmp := TBitmap.Create;

  {Set a bitmap sizes}
  
bmp.Height := Screen.Height;
  bmp.Width := Screen.Width;

  {Get a desktop DC handle - handle of a display device context}
  
DCDesk := GetWindowDC(GetDesktopWindow);

  {Copy to any canvas, here canvas of an image}
  
BitBlt(bmp.Canvas.Handle, 0, 0, Screen.Width, Screen.Height,
         DCDesk, 0, 0, SRCCOPY);

  {Save the bitmap}
  
bmp.SaveToFile('ScreenShot.bmp');

  {Release desktop DC handle}
  
ReleaseDC(GetDesktopWindow, DCDesk);

  {Release a bitmap}
  
bmp.Free;
end;

{---------------------3---------------------}
{
  If you will try to capture the screen to bitmap using BitBlt function
  and have a layered (transparent)  window visible,
  you will get only a picture of the screen without this window.
  To fix it we have to use the new raster-operation code for BitBlt
  function CAPTUREBLT that introduced in Windows 2000 for including
  any windows that are layered on top of your window in the resulting image.
}

procedure CaptureScreen(AFileName: string);
const
  
CAPTUREBLT = $40000000;
var
  
hdcScreen: HDC;
  hdcCompatible: HDC;
  bmp: TBitmap;
  hbmScreen: HBITMAP;
begin
  
// Create a normal DC and a memory DC for the entire screen. The
  // normal DC provides a "snapshot" of the screen contents. The
  // memory DC keeps a copy of this "snapshot" in the associated
  // bitmap.

  
hdcScreen := CreateDC('DISPLAY', nilnilnil);
  hdcCompatible := CreateCompatibleDC(hdcScreen);
  // Create a compatible bitmap for hdcScreen.

  
hbmScreen := CreateCompatibleBitmap(hdcScreen,
    GetDeviceCaps(hdcScreen, HORZRES),
    GetDeviceCaps(hdcScreen, VERTRES));

  // Select the bitmaps into the compatible DC.
  
SelectObject(hdcCompatible, hbmScreen);
  bmp := TBitmap.Create;
  bmp.Handle := hbmScreen;
  BitBlt(hdcCompatible,
    0, 0,
    bmp.Width, bmp.Height,
    hdcScreen,
    0, 0,
    SRCCOPY or CAPTUREBLT);

  bmp.SaveToFile(AFileName);
  bmp.Free;
  DeleteDC(hdcScreen);
  DeleteDC(hdcCompatible);
end;

 

Rate this tip:

poor
very good


Copyright © by SwissDelphiCenter.ch
All trademarks are the sole property of their respective owners