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.