оказалась проблема в bitmap.Free;
вот такой код получился работоспособен
Код:
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 | function getscreen( const x,y: integer ):tbitmap;
var bitmap:tbitmap;
begin
bitmap:=tbitmap . Create;
with bitmap do
begin
bitmap . Width := 100 ;
bitmap . Height := 100 ;
BitBlt(bitmap . Canvas . Handle, 0 , 0 , bitmap . Width, bitmap . Height, GetDC( GetDesktopWindow ), x, y, SRCCOPY );
bitmap . SaveToFile( 'temp.bmp' );
result:=bitmap;
end ;
end ;
procedure TForm1 . Button1Click(Sender: TObject);
var J: TJPEGImage;
begin
j:=TJPEGImage . Create;
j . Assign(getscreen( 500 , 500 ));
J . DIBNeeded;
J . CompressionQuality := 75 ;
J . Compress;
J . SaveToFile( 'temp.jpg' );
J . Free;
end ;
|