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.
【推荐】编程新体验,更懂你的AI,立即体验豆包MarsCode编程助手
【推荐】凌霞软件回馈社区,博客园 & 1Panel & Halo 联合会员上线
【推荐】抖音旗下AI助手豆包,你的智能百科全书,全免费不限次数
【推荐】博客园社区专享云产品让利特惠,阿里云新客6.5折上折
【推荐】轻量又高性能的 SSH 工具 IShell:AI 加持,快人一步