本文整理自网络,侵删。
//// ------------------------------------------------------------------------------------//// 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 2009 泛型容器单元(generics.collections)[1]: tlist<t>
更多相关阅读请进入《Delphi》频道 >>