Delphi7 压缩图片(BMP、JPG、PNG)

/// <summary>
/// 压缩图片(BMP、JPG、PNG)
/// </summary>
/// <param name="FileName">文件路径</param>
/// <param name="Width">需要压缩后的宽度</param>
/// <param name="Height">需要压缩后的高度</param>
/// <param name="PressQuality">压缩质量</param>
/// <returns>是否压缩成功</returns>
function CompressImageFile(FileName: string;  Width, Height: integer; PressQuality:Integer= 90): Boolean;
function GetNewSize(OldWidth, OldHeight: integer; NewWidth, NewHeight: integer; var RetWidth, RetHeight: integer):Boolean;
var
H:Boolean;
begin
Result := False;
if (NewHeight < OldHeight) or (NewWidth < OldWidth) then
begin
H := NewHeight < OldHeight;

if H then
begin //按比例缩小,按高度来算高度的
RetHeight := NewHeight;
RetWidth := Round(OldWidth *  (NewHeight/OldHeight));
end
else
begin //按比例缩小,按宽度来算宽度的
RetWidth := NewWidth;
RetHeight := Round(OldHeight * (NewWidth/OldWidth));
end;
Result:=True;
end;
end;
var
bmp: TBitmap;
jpg: TJpegImage;
png: TPNGGraphic;
i: Integer;
sTemp: string;
begin

Result := False;
try
bmp := TBitmap.Create;
jpg := TJPEGImage.Create;
png := TPNGGraphic.Create;
if pos(UpperCase('.bmp'), UpperCase(filename)) <> 0 then   //bmp格式
begin
bmp.LoadFromFile(filename);
jpg.Assign(bmp);
jpg.CompressionQuality := PressQuality;
jpg.Compress;
if GetNewSize(bmp.Width,bmp.height,Width,Height,Width,Height) then
begin
bmp.height := Height;
bmp.Width := Width;
bmp.Canvas.StretchDraw(bmp.Canvas.ClipRect, jpg);
jpg.Assign(bmp);
sTemp := filename + '.lq';
jpg.SaveToFile(sTemp);
DeleteFile(filename);
CopyFile(PChar(sTemp), PChar(filename), True);
DeleteFile(sTemp);
Result := True;
end;
end
else if pos(UpperCase('.png'), UpperCase(filename)) <> 0 then //jpg其它格式
begin
jpg.LoadFromFile(filename);
if GetNewSize(jpg.Width,jpg.height,Width,Height,Width,Height) then
begin
bmp.height := Height;
bmp.Width := Width;
bmp.Canvas.StretchDraw(bmp.Canvas.ClipRect, jpg);
jpg.Assign(bmp);
jpg.CompressionQuality := PressQuality;
jpg.Compress;
sTemp := filename + '.lq';
jpg.SaveToFile(sTemp);
DeleteFile(filename);
CopyFile(PChar(sTemp), PChar(filename), True);
DeleteFile(sTemp);
Result := True;
end;
end
else if pos(UpperCase('.png'), UpperCase(filename)) <> 0 then   //png格式
begin
png.LoadFromFile(filename);
if GetNewSize(png.Width,png.height,Width,Height,Width,Height) then
begin
bmp.height := Height;
bmp.Width := Width;
bmp.Canvas.StretchDraw(bmp.Canvas.ClipRect, png);
jpg.Assign(bmp);
jpg.CompressionQuality := PressQuality;
jpg.Compress;
sTemp := filename + '.lq';
jpg.SaveToFile(sTemp);
DeleteFile(filename);
CopyFile(PChar(sTemp), PChar(filename), True);
DeleteFile(sTemp);
Result := True;
end;
end;
finally
FreeAndNil(bmp);
FreeAndNil(jpg);
FreeAndNil(png);
end;
end;

procedure TForm1.btn1Click(Sender: TObject);
begin
CompressImageFile('d:\png\222.png', 200, 200);
end;