网上的都少了这两句
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.
|
请发表评论