Code:

var

{©Drkb v.3(2007): www.drkb.ru,

®Vit (Vitaly Nevzorov) - nevzorov@yahoo.com}

Dwh : HWND;

DRect: TRect;

DescDC: HDC;

Canv: TCanvas;

i: TJPEGImage;

begin

try

   i := TJPEGImage.create;

   try

     Canv := TCanvas.Create();

     i.CompressionQuality := 100;

     image.Width := screen.width;

     image.height := screen.height;

     DWH := GetDesktopWindow;

     GetWindowRect(DWH, DRect);

     DescDC := GetDeviceContext(DWH);

     Canv.Handle := DescDC;

     DRect.Left := 0;

     DRect.Top := 0;

     DRect.Right := screen.Width;

     DRect.Bottom := screen.Height;

     Image.Canvas.CopyRect(DRect, Canv, DRect);

     i.assign(Image.Picture.Bitmap);

     I.SaveToFile('M:\MyFile.jpg');

     Canv.free;

   finally

     i.free;

   end;

except

end;

Code:

program ScrShop;

uses

Windows;

procedure ApiScrCapture(FileName: String);

type

  TScr = array [0..1] of Byte;

  PScr = ^TScr;

var

  hBmp       : hBitmap;

  DeskDC     : hDC;

  DC         : hDC;

  BFH        : BITMAPFILEHEADER;

  BIH        : tagBITMAPINFO;

  ScrX, ScrY : Integer;

  F          : File;

  ScrSize    : Cardinal;

  Bits       : PScr;

begin

  SCRX     := GetSystemMetrics(SM_CXSCREEN);

  SCRY     := GetSystemMetrics(SM_CYSCREEN);

  ScrSize  := ScrX * ScrY * 3;

  GetMem(Bits, ScrSize);

  DeskDC   := GetDC(0);

  hBmp     := CreateCompatibleBitmap(DeskDC, ScrX, ScrY);

  DC       := CreateCompatibleDC(DeskDC);

  SelectObject(DC, hbmp);

  BitBlt(DC, 0, 0, SCRX, SCRY, DeskDC, 0, 0, SrcCopy);

  with BFH do

  begin

    bfType      := $4D42;

    bfSize      := SCRX * SCRY * 3 + SizeOf(BFH) + SizeOf(BIH);

    bfReserved1 := 0;

    bfReserved2 := 0;

    bfOffBits   := SizeOf(BFH) + SizeOf(BIH);

  end;

  with BIH.bmiHeader do

  begin

   biSize         := sizeof(BIH);

   biWidth        := SCRX;

   biHeight       := SCRY;

   biPlanes       := 1;

   biBitCount     := 24;

   biCompression  := BI_RGB;

   biSizeImage    := ScrSize;

   biClrImportant := 0;

  end;

  GetDiBits(DC, hbmp, 0, SCRY, Bits, BIH, DIB_RGB_COLORS);

  DeleteObject(hbmp);

  AssignFile(F, FileName);

  Rewrite(F, 1);

  Blockwrite(F, BFH, SizeOf(BFH));

  Blockwrite(F, BIH, SizeOf(BIH));

  Blockwrite(F, bits^, ScrSize);

  CloseFile(F);

  FreeMem(Bits);

end;

begin

  ApiScrCapture('1.bmp');

end.

Code:

procedure TForm1.Button1Click(Sender: TObject);

var

DC: HDC;

Canva: TCanvas;

B: TBitmap;

begin

Canva := TCanvas.Create;

B := TBitmap.Create;

DC := GetDC(0);

try

   Canva.Handle := DC;

   with Screen do

   begin

     B.Width := Width;

     B.Height := Height;

     B.Canvas.CopyRect(Rect(0, 0, Width, Height),

     Canva, Rect(0, 0, Width, Height));

     B.SaveToFile('c:\Мои документы\screentofile.bmp');

   end

finally

   ReleaseDC(0, DC);

   B.Free;

   Canva.Free

end

end;