delphi:如何设置压缩jpeg图片质量?


 uses
  System.SysUtils,
  System.Variants,
  System.Win.ComObj,
  Winapi.Windows,
  Winapi.Wincodec,
  Winapi.ActiveX,
  Vcl.Graphics;

procedure SaveBitmapAsJpeg(Bitmap: TBitmap; ImageQuality: Single; FileName: string);
const
  PROPBAG2_TYPE_DATA = 1;
var
  ImagingFactory: IWICImagingFactory;
  Width, Height: Integer;
  Stream: IWICStream;
  Encoder: IWICBitmapEncoder;
  Frame: IWICBitmapFrameEncode;
  PropBag: IPropertyBag2;
  PropBagOptions: TPropBag2;
  V: Variant;
  PixelFormat: TGUID;
  Buffer: TBytes;
  BitmapInfo: TBitmapInfo;
  hBmp: HBITMAP;
  WICBitmap: IWICBitmap;
  Rect: WICRect;
begin
  Width := Bitmap.Width;
  Height := Bitmap.Height;

  OleCheck(
    CoCreateInstance(CLSID_WICImagingFactory, nil, CLSCTX_INPROC_SERVER 
      or CLSCTX_LOCAL_SERVER, IUnknown, ImagingFactory)
  );

  OleCheck(ImagingFactory.CreateStream(Stream));
  OleCheck(Stream.InitializeFromFilename(PChar(FileName), GENERIC_WRITE));
  OleCheck(ImagingFactory.CreateEncoder(GUID_ContainerFormatJpeg, GUID_NULL, Encoder));
  OleCheck(Encoder.Initialize(Stream, WICBitmapEncoderNoCache));
  OleCheck(Encoder.CreateNewFrame(Frame, PropBag));

  PropBagOptions := Default(TPropBag2);
  PropBagOptions.pstrName := 'ImageQuality';
  PropBagOptions.dwType := PROPBAG2_TYPE_DATA;
  PropBagOptions.vt := VT_R4;
  V := VarAsType(ImageQuality, varSingle);
  OleCheck(PropBag.Write(1, @PropBagOptions, @V));
  OleCheck(Frame.Initialize(PropBag));
  OleCheck(Frame.SetSize(Width, Height));
  if Bitmap.AlphaFormat=afDefined then begin
    PixelFormat := GUID_WICPixelFormat32bppBGRA
  end else begin
    PixelFormat := GUID_WICPixelFormat32bppBGR;
  end;
  Bitmap.PixelFormat := pf32bit;
  SetLength(Buffer, 4*Width*Height);
  BitmapInfo := Default(TBitmapInfo);
  BitmapInfo.bmiHeader.biSize := SizeOf(BitmapInfo);
  BitmapInfo.bmiHeader.biWidth := Width;
  BitmapInfo.bmiHeader.biHeight := -Height;
  BitmapInfo.bmiHeader.biPlanes := 1;
  BitmapInfo.bmiHeader.biBitCount := 32;
  hBmp := Bitmap.Handle;
  GetDIBits(Bitmap.Canvas.Handle, hBmp, 0, Height, @Buffer[0], BitmapInfo, 
    DIB_RGB_COLORS);
  OleCheck(ImagingFactory.CreateBitmapFromMemory(Width, Height, PixelFormat, 
    4*Width, Length(Buffer), @Buffer[0], WICBitmap));
  Rect.X := 0;
  Rect.Y := 0;
  Rect.Width := Width;
  Rect.Height := Height;
  OleCheck(Frame.WriteSource(WICBitmap, @Rect));
  OleCheck(Frame.Commit);
  OleCheck(Encoder.Commit);
end;


联系电话:
020-00000000
联系电话:
020-00000000
联系电话:
020-12345678