本文整理自网络，侵删。
添加引用：uses JPEG;
//=====================图片处理函数，将覆盖原图片文件===========================
//=====filename:图片完整路径 PressQuality:压缩质量 Width:宽 Height:高
function CompressMainFun(filename: String; PressQuality,Width,Height:integer): Boolean;
var
bmp: TBitmap;
jpg: TJpegImage;
i: Integer;
sTemp:string;
begin
Result := False;
if pos(UpperCase('.bmp'), UpperCase(filename)) <> 0 then //bmp格式
begin
bmp.LoadFromFile(filename);
jpg.Assign(bmp);
jpg.CompressionQuality := PressQuality;
jpg.Compress;
bmp.height := Height;
bmp.Width := Width;
bmp.Canvas.StretchDraw(bmp.Canvas.ClipRect, jpg);
jpg.Assign(bmp);
sTemp := filename + '.jpg';
jpg.SaveToFile(sTemp);
DeleteFile(filename);
CopyFile(PChar(sTemp), PChar(filename), True);
DeleteFile(sTemp);
end
else //其它格式
begin
jpg.LoadFromFile(filename);
bmp.height := Height;
bmp.Width := Width;
bmp.Canvas.StretchDraw(bmp.Canvas.ClipRect, jpg);
jpg.Assign(bmp);
jpg.CompressionQuality := PressQuality;
jpg.Compress;
sTemp := filename + '.jpg';
jpg.SaveToFile(sTemp);
DeleteFile(filename);
CopyFile(PChar(sTemp), PChar(filename), True);
DeleteFile(sTemp);
end;
Result := True;
end; 相关阅读 >>
Delphi 2009 中 tstrings 与 tstream 的增强
Delphi win7,win2008,win2003,winxp 屏蔽ctrl+alt+del
Delphi读取webbrowse中的图片显示在image中
Delphi xe实现android 添加图片资源到应用并使用它
Delphi setcursorpos函数在窗口上定位鼠标坐标
更多相关阅读请进入《Delphi》频道 >>
