procedure StretchGraphic(
const src: TGraphic;
//the TGraphic to convert
const dest: TJPEGImage;
//the TJPEGImage which receives the converted graphic
const DestWidth, DestHeight: integer);
//maximum width and height of the destination jpeg
var temp, aCopy: TBitmap;
faktor: double;
begin
if src.Width > DestWidth
then
begin
faktor := DestWidth / src.Width;
if (src.Height * faktor) > DestHeight
then
faktor := DestHeight / src.Height;
end
else
begin
faktor := DestHeight / src.Height;
if (src.Width * faktor) > DestWidth
then
faktor := DestWidth / src.Width;
end;
aCopy := TBitmap.Create;
try
aCopy.PixelFormat := pf24Bit;
aCopy.Assign(src);
temp := TBitmap.Create;
try
temp.Width := round(src.Width * faktor);
temp.Height := round(src.Height * faktor);
try
SetStretchBltMode(temp.Canvas.Handle,HALFTONE);
StretchBlt(temp.Canvas.Handle,
0,0,temp.Width,temp.Height,
aCopy.Canvas.Handle,
0,0,aCopy.Width,aCopy.Height,
SRCCOPY);
dest.Assign(temp);
except
on E:
Exception do
MessageBox(0,PAnsiChar(E.
Message),
nil,MB_OK
or MB_ICONERROR);
end;
finally
temp.Free;
end;
finally
aCopy.Free;
end;
end;