天天看點

Delphi壓縮圖檔代碼

添加引用: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;