1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:

procedure GetScreenShot (var ABitmap : TBitmap); 
var 
  DC : THandle; 
begin 
  if Assigned(ABitmap) then                  // Prüfen ob gültiges Bitmap übergeben wurde 
  begin 
    DC := GetDC(0);                          // Desktop DC holen 
    try 
      ABitmap.Width := Screen.Width;           // Bitmapgrösse den... 
      ABitmap.Height := Screen.Height;         // Bildschirm anpassen 
      BitBlt(ABitmap.Canvas.Handle,            // Dekstop 
             0,0,Screen.Width,Screen.Height,   // in 
             DC,                               // das 
             0,0,                              // Bitmap 
             SrcCopy                           // kopieren 
        ); 
    finally 
      ReleaseDC(0, DC);                        // DC wieder freigeben 
    end; 
  end; 
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:

procedure TForm1.Button1Click(Sender: TObject); 
var 
  B : TBitmap; 
begin 
  B := TBitmap.Create; 
  try 
    GetScreenShot(B); 
    Image1.Picture.Assign(B); 
  finally 
    B.Free; 
  end; 
end;