1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:

procedure ScreenToFile(aFileName: string); 
var 
  Bitmap: TBitmap; 
  JPG : TJPEGImage; 
  Canvas: TCanvas; 
begin 
  Canvas := TCanvas.Create; 
  try 
    Canvas.Handle := GetWindowDC(0); 
    try 
      Bitmap := TBitmap.Create; 
      JPG := TJPEGImage.Create; 
      try 
        Bitmap.Width := Screen.DesktopWidth; 
        Bitmap.Height:= Screen.DesktopHeight; 
        Bitmap.PixelFormat := pfDevice; 

        BitBlt(Bitmap.Canvas.Handle, 0, 0, Pred(Screen.DesktopWidth), Pred( 
            Screen.DesktopHeight), Canvas.Handle, Screen.DesktopLeft, 
            Screen.DesktopTop, Bitmap.Canvas.CopyMode); 

        JPG.Assign(Bitmap); 
        JPG.SaveToFile(aFileName); 
      finally 
        Bitmap.Free; 
        JPG.Free; 
      end; 
    finally 
      ReleaseDC(0, Canvas.Handle); 
    end; 
  finally 
    Canvas.Free; 
  end; 
end;