delphi 图片压缩，存储方法

实际代码，成功

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, RzButton,
  RzPanel;

type
  TForm1 = class(TForm)
    RzButton1: TRzButton;
    SaveDialog1: TSaveDialog;
    OpenDialog1: TOpenDialog;
    RzButton2: TRzButton;
    RzPanel1: TRzPanel;
    ImageShow: TImage;
    RzButton3: TRzButton;
    RzButton4: TRzButton;
    procedure RzButton1Click(Sender: TObject);
    procedure RzButton2Click(Sender: TObject);
    procedure RzButton3Click(Sender: TObject);
    procedure RzButton4Click(Sender: TObject);
  private
    { Private declarations }
  public
   function CompressMainFun(filename: string; PressQuality, Width, Height: integer): Boolean;
    function SaveImage(filename: string; vStream: TMemoryStream; savefilepath: string): Boolean;
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
uses
  pngimage, Vcl.Imaging.jpeg, Character;
// 如何将TImage里的图片另存为BMP、JPG、PNG格式的文件

// 显示图片文件
procedure TForm1.RzButton1Click(Sender: TObject);
begin
  with OpenDialog1 do
  begin
    if not Execute then
      Exit;
    ImageShow.Picture.LoadFromFile(FileName);

  end;
end;

// 保存图片
procedure TForm1.RzButton2Click(Sender: TObject);
var
  vPng: TPNGObject;
  vJpg: TJPEGImage;
  vBmp: TBitmap;
  vTmp: string;
  FType: Integer;
  vStream: TStream;
begin

  with SaveDialog1 do
  begin
    if not Execute then
      Exit;
    FType := -1;
    vTmp := ExtractFileExt(FileName);   //分析用户保存的图像类型
    if vTmp = '.png' then
      FType := 0
    else if vTmp = '.jpg' then
      FType := 1
    else if vTmp = '.bmp' then
      FType := 2;
    vTmp := FileName;   //这是文件路径
  end;
  try
    if FType = -1 then  //默认是bmp
      FType := 2;
    vStream := TMemoryStream.Create;   //创建流
    ImageShow.Picture.Graphic.SaveToStream(vStream);  // 将Image里的图像读到流里
    if vStream.Size = 0 then  //判断有没有图像
    begin
      FreeAndNil(vStream);
      ShowMessage('没有图像！');
      Exit;
    end;
    vStream.Position := 0;  //移动到流的开头，不要少了这步
    if FType = 0 then  //保存成Png 文件
    begin
      vPng := TPNGObject.Create;
      vPng.LoadFromStream(vStream);
      vPng.SaveToFile(vTmp);
      FreeAndNil(vPng);

    end;
    if FType = 1 then  //保存成jpg文件
    begin
      vJpg := TJPEGImage.Create;
      vBmp := TBitmap.Create;  //先创建一个bmp
      vBmp.Assign(ImageShow.Picture.Graphic);  //把Image里的图像读到bmp里

      vJpg.Assign(vBmp);  //在这里将bmp的图像转成jpg
      vJpg.SaveToFile(vTmp);
      FreeAndNil(vBmp);
      FreeAndNil(vJpg);
    end;
    if FType = 2 then   //保存成bmp文件
    begin
      ImageShow.Picture.Graphic.SaveToFile(vTmp);  //bmp的最简单，直接另存为就好
    end;
    FreeAndNil(vStream);
  except
    on E: Exception do
    begin
      MessageDlg('图像保存失败！原因是：' + #13 + E.Message, mtWarning, [mbOK], 0);
      Exit;
    end;
  end;

end;

// 使用saveImage方法保存图片
procedure TForm1.RzButton3Click(Sender: TObject);
var
  _stream: TMemoryStream;
begin
  try
    _stream := TMemoryStream.Create;
    ImageShow.Picture.Graphic.SaveToStream(_stream);  // 将Image里的图像读到流里
//    if SaveImage('我的.PNG' , _stream, ExtractFileDir(ParamStr(0)) ) then
//    ShowMessage('OK');
    if SaveImage('我的中国.jpg', _stream, ExtractFileDir(ParamStr(0))) then
      ShowMessage('OK');
  finally
    _stream.Free;
  end;

end;

//保存图片通用方法
function TForm1.SaveImage(filename: string; vStream: TMemoryStream; savefilepath: string): Boolean;
var
  vPng: TPNGObject;
  vJpg: TJPEGImage;
  vBmp: TBitmap;
  vTmp: string;
  FType: Integer;
  num1: Integer;
begin
  if Trim(filename) = '' then
  begin
    result := false;
    Exit;
  end;
  num1 := Pos('.', filename);
  vTmp := ToLower(Copy(filename, num1, Length(filename) + 1 - num1));
  FType := -1;
  if vTmp = '.png' then
    FType := 0
  else if vTmp = '.jpg' then
    FType := 1
  else if vTmp = '.bmp' then
    FType := 2;

  try
    if FType = -1 then  //默认是bmp
      FType := 2;

    if vStream.Size = 0 then  //判断有没有图像
    begin
      FreeAndNil(vStream);
      ShowMessage('没有图像！');
      Exit;
    end;
    savefilepath := savefilepath + '\image';
    vStream.Position := 0;  //移动到流的开头，不要少了这步
    if FType = 0 then  //保存成Png 文件
    begin
      vPng := TPNGObject.Create;
      vPng.LoadFromStream(vStream);
      vPng.SaveToFile(savefilepath + '\' + filename);
      FreeAndNil(vPng);

    end;
    if FType = 1 then  //保存成jpg文件
    begin
      vJpg := TJPEGImage.Create;
      vJpg.LoadFromStream(vStream);
      vJpg.SaveToFile(savefilepath + '\' + filename);
      FreeAndNil(vJpg);
    end;
    if FType = 2 then   //保存成bmp文件
    begin
      vBmp := TBitmap.Create;  //先创建一个bmp
      vBmp.LoadFromStream(vStream);
      vBmp.SaveToFile(savefilepath + '\' + filename);
    end;
  except
    on E: Exception do
    begin
      Result := false;
//        MessageDlg('图像保存失败！原因是：'+#13+E.Message,mtWarning,[mbOK],0);
      Exit;
    end;
  end;

  Result := true;
end;

//=====filename:图片完整路径  PressQuality:压缩质量 Width:宽  Height:高
function TForm1.CompressMainFun(filename: string; PressQuality, Width, Height: integer): Boolean;
var
  bmp: TBitmap;
  jpg: TJpegImage;
  i: Integer;
  sTemp: string;
begin
  Result := False;
  try
    jpg := TJpegImage.create;
    bmp:= TBitmap.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 := ExtractFilePath(filename)+'11'+ '.bmp';
    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 :=  ExtractFilePath(filename)+'11'+ '.jpg';
    jpg.SaveToFile(sTemp);
//    DeleteFile(filename);
//    CopyFile(PChar(sTemp), PChar(filename), True);
//    DeleteFile(sTemp);
  end;
    Result := True;
  finally
    FreeAndNil(jpg);
    FreeAndNil(jpg);
  end;

end;

// 压缩图片
procedure TForm1.RzButton4Click(Sender: TObject);
var
  _filename: string;
begin
  if OpenDialog1.Execute then
  begin

    CompressMainFun(OpenDialog1.FileName,90, 200, 200);  //140K图片压缩后只有8K
  end;

end;

end.