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.

转载于:https://www.cnblogs.com/hssbsw/archive/2012/03/13/2394410.html