procedure TForm1.Button1Click(Sender: TObject);
var
dc:HDC;
begin
dc:=GetDc(0);
BitBlt(image1.canvas.handle,0,0,width,height,dc,0,0,srccopy);
end;

vagy

procedure SaveScreen(ALeft, ATop, ARight, ABottom: Integer; BmpFile:
string);
var
FCanvas: TCanvas;
Bitmap: TBitmap;
FRect: TRect;
begin
FCanvas := TCanvas.Create;
FCanvas.Handle := GetDC( 0 );
try
Bitmap := TBitmap.Create;
try
Bitmap.Width := ARight;
Bitmap.Height := ABottom;
FRect := Rect( aLeft, ATop, ARight, ABottom );
Bitmap.Canvas.CopyRect( FRect, FCanvas, FRect );
Bitmap.SaveToFile( BmpFile );
finally
Bitmap.Free;
end;
finally
ReleaseDC( 0, FCanvas.Handle );
FCanvas.Free;
end;
end;