Wykonanie zrzutu ekranu

Przedstawiona procedura wykonuje zrzut ekranu do obiektu TImage, a następnie zapisuje obraz na dysku jako plik capture.bmp w katalogu, z którego uruchomiliśmy program.

procedure TForm1.GetDesktopBitmap;

 Var

  DeskHWnd : Hwnd;

  dc: HDC;

  ScreenWidth, ScreenHeight: Integer;

  TheBmp : TBitmap;

  FName : String;

begin



{Pobieramy uchwyt pulpitu}

  DeskHWnd := GetDeskTopWindow;

  dc := GetDC(DeskHWnd);


{Pobieramy rozdzielczość ekranu}

  ScreenWidth := GetDeviceCaps(dc,HORZRES);

  ScreenHeight := GetDeviceCaps(dc,VERTRES);


{Tworzymy Bitmapę}

  TheBmp := TBitmap.Create;

  TheBmp.Width := ScreenWidth;

  TheBmp.Height := ScreenHeight;


{Rysujemy ekran}

  BitBlt(TheBmp.Canvas.Handle, 0,0,ScreenWidth,ScreenHeight,dc, 0,0,SRCCOPY);


{Wrzucamy bitmape do TImage}

  Image1.Picture.Bitmap := TheBmp;

  Application.ProcessMessages;


{Usuwamy z pamięci bitmapę}

  TheBmp.Free;


  ReleaseDC(DeskHWnd, dc);


{Zapisujemy jako plik}

  FName := ExtractFilePath(Application.Exename) + 'capture.bmp';


  Image1.Picture.Bitmap.SaveToFile(FName);

end;

procedure TForm1.GetDesktopBitmap;

Var

DeskHWnd : Hwnd;

dc: HDC;

ScreenWidth, ScreenHeight: Integer;

TheBmp : TBitmap;

FName : String;

begin

{Pobieramy uchwyt pulpitu}

DeskHWnd := GetDeskTopWindow;

dc := GetDC(DeskHWnd);

{Pobieramy rozdzielczość ekranu}

ScreenWidth := GetDeviceCaps(dc,HORZRES);

ScreenHeight := GetDeviceCaps(dc,VERTRES);

{Tworzymy Bitmapę}

TheBmp := TBitmap.Create;

TheBmp.Width := ScreenWidth;

TheBmp.Height := ScreenHeight;

{Rysujemy ekran}

BitBlt(TheBmp.Canvas.Handle, 0,0,ScreenWidth,ScreenHeight,dc, 0,0,SRCCOPY);

{Wrzucamy bitmape do TImage}

Image1.Picture.Bitmap := TheBmp;

Application.ProcessMessages;

{Usuwamy z pamięci bitmapę}

TheBmp.Free;

ReleaseDC(DeskHWnd, dc);

{Zapisujemy jako plik}

FName := ExtractFilePath(Application.Exename) + 'capture.bmp';

Image1.Picture.Bitmap.SaveToFile(FName);

end;

Autor: Nakiel