delphi JPG图片 旋转 切边 缩放


本文整理自网络,侵删。

 
unit UCutFigure_JPG;
//JPG 切图


interface

uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
     Dialogs, ExtCtrls, StdCtrls,Math, jpeg
 ;

//向左旋转X度 
procedure Rotate(Srcbmp, DestBmp: TBitmap; dbTheta: Double);
 //毫米单位转换为英寸单位 
function MmToInch(Length: Extended): Extended;
//英寸单位转换为毫米单位
function InchToMm(Length: Extended): Extended;
function CutFigure_JPG(图片文件名:string;旋转角度:integer;切边_上,切边_下,切边_左,切边_右:real;缩放_宽,缩放_高:real):Integer;
implementation

 function CutFigure_JPG(图片文件名:string;旋转角度:integer;切边_上,切边_下,切边_左,切边_右:real;缩放_宽,缩放_高:real):Integer;
var
  JpgSrc,JpgDest : TJpegImage;
  BmpSrc, BmpDest: TBitmap;
  F_上,F_下,F_左,F_右,F_长,F_宽:integer;//切边值
  F_缩放比率:real;
  F_处理状态:boolean;
 begin
  //文件名,含全路径
  if not FileExists(图片文件名) then  exit;//文件不存在则退出
  
   JpgSrc := TJpegImage.Create;
   JpgDest:=TJpegImage.Create ;
   BmpSrc:=TBitmap.Create;
   BmpDest:=TBitmap.Create ;


   JpgSrc.LoadFromFile(图片文件名);//加载文件
   BmpSrc.Assign(JpgSrc);
   F_处理状态:=False;//未处理过
  if 旋转角度>0 then
  begin
   Rotate(BmpSrc, BmpDest,旋转角度); //由于函数是左向旋转,所以这里角度设置为270。
   F_处理状态:=true;
  end;


  if (切边_上>0)  or (切边_下>0) or (切边_左>0)  or (切边_右>0)  then
  begin
    //需要切边
   if F_处理状态=true then     
    BmpSrc.Assign(BmpDest);
    //切边传进来的参数,为cm
    if 切边_上<0 then 切边_上:=0;
    if 切边_下<0 then 切边_下:=0;
    if 切边_左<0 then 切边_左:=0;
    if 切边_右<0 then 切边_右:=0;

    
    F_上:=Round(MmToInch(切边_上)*10*96);
    F_下:=Round(MmToInch(切边_下)*10*96);
    F_左:=Round(MmToInch(切边_左)*10*96);
    F_右:=Round(MmToInch(切边_右)*10*96);

    if (F_上+F_下<BmpSrc.Height) and (F_左+F_右>=BmpSrc.Width ) then
    begin    //值超范围,不处理
      BmpDest.Height:=BmpSrc.Height-(F_上+F_下);
      BmpDest.Width:=BmpSrc.Width-(F_左+F_右);
      SetStretchBltMode(BmpDest.Canvas.Handle,HALFTONE);//设置指位图拉伸模式
      stretchblt(BmpDest.Canvas.Handle,0,0,BmpDest.Width,BmpDest.Height,BmpSrc.Canvas.Handle,F_左,F_上,BmpDest.Width,BmpDest.Height,srccopy); //从源矩形中复制一个位图到目标矩形并适当压缩
       F_处理状态:=true;
    end ;

  end;

  if  (缩放_高>0) or (缩放_宽>0) then
  begin
    //需要缩放
    if F_处理状态=true then
       BmpSrc.Assign(BmpDest);

    F_长:=Round(MmToInch(缩放_高)*10*96);
    F_宽:=Round(MmToInch(缩放_宽)*10*96);


    if (F_长>0) and (F_宽>0)  and  (BmpSrc.Height>F_长) and (BmpSrc.Width >F_宽) then
    begin
      //如果都超过,则等比缩小到其中较大的一个值等于目标值
      if (F_长/BmpSrc.Height)>(F_宽/BmpSrc.Width) then
      begin
        F_缩放比率:=F_宽/BmpSrc.Width;
      end
      else
      begin
        F_缩放比率:=F_长/BmpSrc.Height;
      end;
    end
    else
    if (F_长>0)  and  (BmpSrc.Height>F_长) then
    begin
       F_缩放比率:=F_长/BmpSrc.Height;
    end
    else
    if (F_宽>0) and (BmpSrc.Width >F_宽) then
    begin
      F_缩放比率:=F_宽/BmpSrc.Width;
    end
    else
    begin
      F_缩放比率:=-1;//如果没取到值,或原图已经小于设定值则不处理
    end;

    if F_缩放比率>0 then
    begin
      BmpDest.Height:=Round(BmpSrc.Height*F_缩放比率);
      BmpDest.Width:=Round(BmpSrc.Width *F_缩放比率);

      SetStretchBltMode(BmpDest.Canvas.Handle,HALFTONE);//设置指位图拉伸模式
      stretchblt(BmpDest.Canvas.Handle,0,0,BmpDest.Width,BmpDest.Height,BmpSrc.Canvas.Handle,0,0,BmpSrc.Width,BmpSrc.Height,srccopy); //从源矩形中复制一个位图到目标矩形并适当压缩
      F_处理状态:=true;
    end;
  end;

  if F_处理状态=true then
  begin
    //处理后,保存图片
    JpgDest.CompressionQuality := 100;
    JpgDest.Assign(BmpDest);
    JpgDest.SaveToFile(图片文件名);
  end;

   JpgSrc.Free;
   JpgDest.free;
   BmpSrc.Free;
   BmpDest.Free;

 end;



 procedure Rotate(Srcbmp, DestBmp: TBitmap; dbTheta: Double);//此过程是网上找的,不记得原博文地址了,抱歉
var
  ptOrgCenter, ptTarCenter, ptc: TPoint;
  pta: array[0..3] of TPoint;
  ba: array[0..3] of integer;
  i: integer;
  function RotateXY(dbTheda: double; p1: TPoint): TPoint;
  var
    dbA: double;
    _cosA, _sinA, _dbLastT: double;
  begin
    _dbLastT := -99999.999;
    _cosA :=0.0;
    _sinA :=0.0;
 
    if dbTheda <> _dbLastT then
    begin
      dbA := dbTheda * Pi / 180;
      _sinA := sin(dbA);
      _cosA := cos(dbA);
      _dbLastT := dbTheda;
    end;
 
    Result.x := round(p1.x * _cosA + p1.y * _sinA);
    Result.y := round(-p1.x * _sinA + p1.y * _cosA);
  end;
begin
  ptOrgCenter.x := Srcbmp.Width div 2;
  ptOrgCenter.y := Srcbmp.Height div 2;
 
  pta[0] := RotateXY(dbTheta,Point(0, 0));
  //这里不知道原来为何减1
  {pta[1]:=RotateXY(dbTheta,Point(Srcbmp.Width - 1, 0));
  pta[2]:=RotateXY(dbTheta,Point(0, Srcbmp.Height - 1));
  pta[3]:=RotateXY(dbTheta,Point(Srcbmp.Width - 1, Srcbmp.Height - 1));
  }
  pta[1] := RotateXY(dbTheta,Point(Srcbmp.Width, 0));
  pta[2] := RotateXY(dbTheta,Point(0, Srcbmp.Height));
  pta[3] := RotateXY(dbTheta,Point(Srcbmp.Width, Srcbmp.Height));
 
 
  DestBmp.PixelFormat := pf32bit;
  DestBmp.Canvas.Brush.Color := clWindow;
 
  for i := 0 to 3 do
    ba[i] := pta[i].x;
 
  DestBmp.width := MaxIntValue(ba) - MinIntValue(ba);
 
  for i := 0 to 3 do
    ba[i] := pta[i].y;

  DestBmp.Height := MaxIntValue(ba) - MinIntValue(ba);
 
  ptc := RotateXY(dbTheta, Point(Srcbmp.Width div 2, Srcbmp.Height div 2));
 
  ptTarCenter.x := DestBmp.Width div 2;
  ptTarCenter.y := DestBmp.Height div 2;
 
  pta[0].x := pta[0].x + ptTarCenter.x - ptc.x;
  pta[0].y := pta[0].y + ptTarCenter.y - ptc.y;
  pta[1].x := pta[1].x + ptTarCenter.x - ptc.x;
  pta[1].y := pta[1].y + ptTarCenter.y - ptc.y;
  pta[2].x := pta[2].x + ptTarCenter.x - ptc.x;
  pta[2].y := pta[2].y + ptTarCenter.y - ptc.y;
 
  if PlgBlt(DestBmp.Canvas.Handle, pta, Srcbmp.Canvas.Handle,
         0, 0, Srcbmp.Width - 1, Srcbmp.Height - 1, 0, 0, 0) then
    DestBmp.Canvas.Draw(0, 0, DestBmp)
  else
    DestBmp.Canvas.TextOut(0,0,'只支持WinNT内核操作系统.');
end;

  //毫米单位转换为英寸单位
function MmToInch(Length: Extended): Extended;
begin
 Result := Length/25.4;
end;
//英寸单位转换为毫米单位
function InchToMm(Length: Extended): Extended;
begin
 Result := Length*25.4;
end;
end.

用中文参数变量,别笑,这样只是为了让大家更好的解读一些重点代码。

注意我这儿的图片质量,都用了高质量,如果觉得处理的大小太大,则可以降低质量来获得小一些的文件

 

注意:
1、参数值为0时,表示该项不处理。
2、处理为依次执行,即旋转、切边、缩放,后一项的参数,也应参考前一项,而非原图参数
3、缩放只支持等比缩放,也就是只会根据宽或高中的一个值进行缩放,根据哪一个值,则适用于大值等于设置值的处理原则。
4、切边是指对应的边去除设定值,缩放则为处理后的目标值不大于设定值。

来源:https://www.cnblogs.com/zhqian/p/8621460.html

相关阅读 >>

Delphi strtodatetime 这个函数在win7下出错

Delphi 判断图像格式bmp jpg gif pcx png psd ras sgi tiff err

Delphi firemonkey应用程序中显示时隐藏虚拟键盘

Delphi 倒计时对话框

Delphi xe 应用程序横竖屏设置

Delphi 选择文件夹对话框 (有新建文件夹按钮)修正版

Delphi 实现对xml文件的读写操作

Delphi 截取字符串的用法

Delphi添加任务栏右键菜单

Delphi一些排序算法

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



打赏

取消

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

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

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

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

评论

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