delphi BitmapCompress

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.