WIC的VCL封装有些受限。它并没有提供任何设置图像质量的方法。而且,我要对那段代码完全缺乏错误检查视而不见。噫!
我认为你需要自己编写代码,使用原始的COM API。可能会像这样:
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;
传递一个0到1之间的图像质量值,其中0表示最低质量(最高压缩),而1表示最高质量(最低压缩)。
我广泛使用了这里找到的问题和答案:
如何在Delphi中使用WIC创建无损JPG
我还大量借鉴了用于创建代码的VCL源代码。如果您希望继续使用,可以使用其属性获取。那将产生以下代码:
uses
System.Variants,
System.Win.ComObj,
Winapi.Windows,
Winapi.Wincodec,
Winapi.ActiveX,
Vcl.Graphics;
procedure SaveWICImageAsJpeg(WICImage: TWICImage; 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;
Rect: WICRect;
begin
Width := WICImage.Width;
Height := WICImage.Height;
ImagingFactory := WICImage.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));
Rect.X := 0;
Rect.Y := 0;
Rect.Width := Width;
Rect.Height := Height;
OleCheck(Frame.WriteSource(WICImage.Handle, @Rect));
OleCheck(Frame.Commit);
OleCheck(Encoder.Commit);
end;
TJPegImage
并将TWICImage
分配给它,使用CompressionQuality
属性设置压缩质量,最后保存你的图像TJPegImage.SaveToFile('sample-JPG.jpg');
。 - RepeatUntil