Delphi压缩图片代码

网上的都少了这两句

bmp:=TBitmap.create;        //先建立后才能用
      jpg:= TJpegImage.create;

///////////////////////////////////////////////

 

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls,jpeg;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}
  //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;
     bmp:=TBitmap.create;        //先建立后才能用
      jpg:= TJpegImage.create;   //先建立后才能用
    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;

procedure TForm1.Button1Click(Sender: TObject);
begin
CompressMainFun('e:\1.jpg',75,640,480);
end;

end.

*********************************************

 function CompressPic(Src,Dest: string; maxWidth: Integer): Boolean;
var
  jpg: TJPEGImage;
  bmp: TBitmap;
  height: Integer;
begin
  Result:= True;
  jpg:= TJPEGImage.Create;
  bmp:= TBitmap.Create;
  try
    try
      jpg.LoadFromFile(Src);
      //jpg.CompressionQuality:= 10;
      //jpg.Compress;
      if jpg.Width> maxWidth then  begin
        bmp.Width:= maxWidth;
        bmp.Height:= maxWidth* jpg.Height div jpg.Width;
        bmp.Canvas.StretchDraw(bmp.Canvas.ClipRect,jpg);

        jpg.Assign(bmp);

        jpg.SaveToFile(Dest);
      end;
      Result:= True;
    except
      on e: Exception do begin
        OutputDebugString(PChar(Format('Compress Pic[%s] error:%s',[ExtractFilePath(Src),e.Message])));
      end;
    end;
  finally
    bmp.Free;
    jpg.Free;
  end;
end;