网上的都少了这两句
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.