delphiXE jpg图片压缩


本文整理自网络,侵删。

 
//
// ------------------------------------------------------------------------------------
//
// uPicPress.pas -- jpg图片压缩:
//
//                            本单元由 佛也没辙q:340066709 亲情奉献
//                                 本单元只在高版本测试通过
// ------------------------------------------------------------------------------------
//


unit uPicPress;

interface

uses
  Winapi.Windows, System.SysUtils, Vcl.Graphics, Vcl.ExtCtrls, Vcl.Imaging.jpeg;

function GetNewSize(OldWidth, OldHeight: integer; NewWidth, NewHeight: integer; var RetWidth, RetHeight: integer):Boolean;
function CompressImageFile(FileName: string;  Width, Height: integer; PressQuality:Integer= 90; outFileName: string=''): Boolean;

implementation

// 计算图片大小比例;
function GetNewSize(OldWidth, OldHeight: integer; NewWidth, NewHeight: integer; var RetWidth, RetHeight: integer):Boolean;
var
   H:Boolean;
begin
   Result := False;
   if (NewHeight < OldHeight) or (NewWidth < OldWidth) then
   begin
      H := NewHeight < OldHeight;

      if H then
      begin //按比例缩小,按高度来算高度的
         RetHeight := NewHeight;
         RetWidth := Round(OldWidth *  (NewHeight/OldHeight));
      end
      else
      begin //按比例缩小,按宽度来算宽度的
         RetWidth := NewWidth;
         RetHeight := Round(OldHeight * (NewWidth/OldWidth));
      end;
      Result:=True;
   end;
end;

// 压缩图片;
function CompressImageFile(FileName: string;  Width, Height: integer; PressQuality:Integer= 100; outFileName: string=''): Boolean;
var
   bmp: TBitmap;
   jpg: TJpegImage;
   i: Integer;
begin
  Result := False;
  try
    bmp := TBitmap.Create;
    jpg := TJPEGImage.Create;
    if pos(UpperCase('.jpg'), UpperCase(FileName)) <> 0 then //jpg其它格式
    begin
      if Trim(outFileName) = '' then
        outFileName := 'd:/tmp.jpg';
      jpg.LoadFromFile(FileName);
      if GetNewSize(jpg.Width, jpg.height, Width, Height, Width, Height) then
      begin
        bmp.height := Height;
        bmp.Width := Width;
        bmp.Canvas.StretchDraw(bmp.Canvas.ClipRect, jpg);
        jpg.Assign(bmp);
        jpg.CompressionQuality := PressQuality;
        jpg.Compress;
        jpg.SaveToFile(outFileName);
        Result := True;
      end;
    end;
  finally
    FreeAndNil(bmp);
    FreeAndNil(jpg);
  end;
end;
end.

相关阅读 >>

设定Delphi环境选项

Delphi 禁用本地网络连接/启用本地网络连接

Delphi 一个中英文记录Delphi实现

Delphi删除文件夹

Delphi getfiletype 判断图像文件类型

Delphi escape/unescape编码

Delphi 数值小数点后不保留0

Delphi 检查ip地址合法性

Delphi 取得 ios 辅助使用里的字型大小

Delphi 正则表达式tperlregex 类的属性与方法

更多相关阅读请进入《Delphi》频道 >>



打赏

取消

感谢您的支持,我会继续努力的!

扫码支持
扫码打赏,您说多少就多少

打开支付宝扫一扫,即可进行扫码打赏哦

分享从这里开始,精彩与您同在

评论

管理员已关闭评论功能...