本文整理自网络，侵删。
unit Unit2;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,math,FMX.Surfaces,
FMX.Controls.Presentation, FMX.StdCtrls, FMX.Objects;
type
TForm2 = class(TForm)
Button1: TButton;
Image1: TImage;
OpenDialog1: TOpenDialog;
Image2: TImage;
Timer1: TTimer;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
class function BitmapCompress(ABitmap: TBitmap): TBitmap;
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
{$R *.fmx}
{ TForm2 }
class function TForm2.BitmapCompress(ABitmap: TBitmap): TBitmap; //耗时耗内存，待优化
var
SaveParams:TBitmapCodecSaveParams;
Astream,bstream:TMemorystream;
Surf: TBitmapSurface;
intoldSize:Int64;
CompressQuality:integer;
BBitmap:TBitmap;
ratio:double;
begin
Astream:=TMemorystream.Create;
Bstream:=TMemorystream.Create;
BBitmap:=TBitmap.Create;
ABitmap.SaveToStream(Astream);
//ratio:=Astream.Size/1024;
// ratio:= 10000/ratio;
//CompressQuality:=ceil(10000/ratio);
// if Astream.Size/1024>4096 then
// CompressQuality:=5
if Astream.Size/1024>2048 then //大图小于15之后失真严重
CompressQuality:=15
else if Astream.Size/1024>1024 then
CompressQuality:=20
else if Astream.Size/1024>512 then
CompressQuality:=50
else if Astream.Size/1024>256 then
CompressQuality:=60
else if Astream.Size/1024>128 then
CompressQuality:=70
else if Astream.Size/1024<50 then
CompressQuality:=100
else
CompressQuality:=80;
//showmessage(CompressQuality.ToString);
SaveParams.Quality:=CompressQuality;
Surf:=TBitmapSurface.Create;
Surf.Assign(Abitmap);
try
if not TBitmapCodecManager.SaveToStream(bStream, Surf, 'jpg',@SaveParams) then
begin
showmessage('图片压缩失败！');
exit;
end;
except
showmessage('图片压缩意外错误！');
exit;
end;
try
if Astream.Size<Bstream.Size then
begin
// Astream.SaveToFile('d:\2.jpg');
BBitmap.LoadFromStream(Astream);
end
else
begin
// bstream.SaveToFile('d:\2.jpg');
BBitmap.LoadFromStream(bstream);
end;
except
showmessage('图片存储失败！');
exit;
end;
BBitmap.SaveToFile('d:\1111.jpg');
result:= BBitmap;
end;
procedure TForm2.Button1Click(Sender: TObject);
var
ABitmap:Tbitmap;
StartTime,EndTime:cardinal;
begin
ABitmap :=FMX.Graphics.TBitmap.Create;
opendialog1.filter:='图片文件(*.bmp;*.png;*.jpeg;*.jpg)|*.bmp;*.png;*.jpeg;*.jpg';
if OpenDialog1.Execute then
begin
//StartTime:=GetTickCount;
ABitmap.LoadFromFile(OpenDialog1.FileName);
// Timer1.Enabled:=true;
image1.Bitmap.LoadFromFile(OpenDialog1.FileName);
image2.Bitmap.Assign(BitmapCompress(ABitmap));
end;
//Timer1.Enabled:=false;
end;
procedure TForm2.Timer1Timer(Sender: TObject);
var
BeginCount,Endcount,StartCount:Cardinal;
begin
// BeginCount:=GetTickCount;//只适用于windows，还没有找到移动端方法计算程序运行时间
end;
end.
相关阅读 >>
Delphi 在firemonkey应用程序中使用torientationsensor获取设备倾斜和指南针航向
Delphi 使用firedac tfdibbackup和tfdibrestore备份和还原firebird
Delphi2007-Delphi2010 程序不出现在任务栏的方法
更多相关阅读请进入《Delphi》频道 >>
