• 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.

  • 相关阅读:
    数据分析英国电商——数据分析可视化
    数据分析英国电商——数据预处理部分
    特征工程入门与实践—3 特征增强
    特征工程入门与实践—2 特征理解
    特征工程入门与实践 —1 特征工程简介
    正则表达式匹配
    linux学习笔记
    python深度学习基础
    Linux命令小记1
    AWS S3操作命令
  • 原文地址:https://www.cnblogs.com/hssbsw/p/2394410.html
Copyright © 2020-2023  润新知