TWebpImage Delphi VCL

Menampilkan gambar Webp pada Form VCL Delphi TWebpImage pada unit Vcl.WebpImage.pas serta merubah gambar Jpg, Bmp dan Png ke Webp atau sebaliknya (converter Webp).

Untuk melakukan semua itu selain unit yang ada kita butuh file Libwebp.dll tentu saja harus yng sesuai dengan bit versi aplikasi yang kita buat. contoh kasus saya membuat aplikasi dengan sistem windows 32 bit, dengan Delphi VCL XE8 pada windows 10 64 bit yang nantinya aplikasi yang saya buat dapat berjalan di Windows 32 bit atau 64 bit. Yang saya butuhkan adalah Libwebp.dll 32 bit.

Libwebp.dll ini dapat kita taruh didirectori system windows atau berada dalam satu folder dengan file exe aplikasi. Registrasi dll tidak begitu dibutuhkan. contoh aplikasi bisa download disini juga sudah terdapat Libwebp.dll, alias tinggal dijalankan saja.

selain libwebp untuk dalam membangun aplikasi kita butuh 3 unit yaitu :

1. libwebp.pas
2. Vcl.WebpImage.pas
3. WebpHelpers.pas

unit libwebp; {$ALIGN ON} {$MINENUMSIZE 4} interface const LIB_WEBP = 'libwebp.dll'; type WEBP_CSP_MODE = ( MODE_RGB = 0, MODE_RGBA = 1, MODE_BGR = 2, MODE_BGRA = 3, MODE_YUV = 4); TVP8StatusCode = ( VP8_STATUS_OK = 0, VP8_STATUS_OUT_OF_MEMORY, VP8_STATUS_INVALID_PARAM, VP8_STATUS_BITSTREAM_ERROR, VP8_STATUS_UNSUPPORTED_FEATURE, VP8_STATUS_SUSPENDED, VP8_STATUS_USER_ABORT, VP8_STATUS_NOT_ENOUGH_DATA ); TDecState = ( STATE_HEADER = 0, STATE_PARTS0 = 1, STATE_DATA = 2, STATE_DONE = 3, STATE_ERROR = 4); PWebPDecParams = ^TWebPDecParams; TWebPDecParams = record output: PByte; u, v: PByte; top_y, top_u, top_v: PByte; stride: Integer; u_stride: Integer; v_stride: Integer; mode: WEBP_CSP_MODE; last_y: Integer; output_size: Integer; output_u_size: Integer; output_v_size: Integer; external_buffer: Integer; end; PWebPIDecoder = ^TWebPIDecoder; TWebPIDecoder = record state_: TDecState; w_, h_: integer; params_: TWebPDecParams; dec_: Pointer; end; PVP8Io = ^VP8Io; VP8Io = record width, height: Integer; mb_y: Integer; mb_h: Integer; y, u, v: PByte; y_stride: Integer; uv_stride: Integer; opaque: Pointer; put: function(const io: PVP8Io): Integer; cdecl; setup: function(io: PVP8Io): Integer; cdecl; teardown: procedure(const io: PVP8Io); cdecl; fancy_upscaling: Integer; data_size: Cardinal; data: PByte; bypass_filtering: Integer; end; PVP8Decoder = ^VP8Decoder; VP8Decoder = record end; PWebPConfig = ^TWebPConfig; TWebPConfig = record quality: Single; target_size: Integer; target_PSNR: Single; method: Integer; segments: Integer; sns_strength: Integer; filter_strength: Integer; filter_sharpness: Integer; filter_type: Integer; autofilter: Integer; pass: Integer; show_compressed: Integer; preprocessing: Integer; partitions: Integer; end; TWebPPreset = ( WEBP_PRESET_DEFAULT = 0, WEBP_PRESET_PICTURE, WEBP_PRESET_PHOTO, WEBP_PRESET_DRAWING, WEBP_PRESET_ICON, WEBP_PRESET_TEXT ); PWebPPicture = ^TWebPPicture; PWebPAuxStats = ^TWebPAuxStats; TWebPAuxStats = record PSNR: array[0..3] of Single; coded_size: Integer; block_count: array[0..2] of Integer; header_bytes: array[0..1] of Integer; residual_bytes: array[0..2, 0..3] of Integer; segment_size: array[0..3] of Integer; segment_quant: array[0..3] of Integer; segment_level: array[0..3] of Integer; end; TWebPWriterFunction = function(const data: PByte; data_size: Cardinal; const picture: PWebPPicture): Integer; cdecl; TWebPPicture = record colorspace: Integer; width, height: Integer; y, u, v: PByte; y_stride, uv_stride: Integer; a: PByte; writer: TWebPWriterFunction ; custom_ptr: Pointer; extra_info_type: Integer; extra_info: PByte; stats: PWebPAuxStats; end; procedure WebPFree(p : pointer); cdecl; external LIB_WEBP; function WebPGetDecoderVersion: Integer; cdecl; external LIB_WEBP; function WebPGetInfo(const data: PByte; data_size: Cardinal; width, height: PInteger): Integer; cdecl; external LIB_WEBP; function WebPDecodeRGB(const data: PByte; data_size: Cardinal; width, height: PInteger): PByte; cdecl; external LIB_WEBP; function WebPDecodeRGBA(const data: PByte; data_size: Cardinal; width, height: PInteger): PByte; cdecl; external LIB_WEBP; function WebPDecodeBGR(const data: PByte; data_size: Cardinal; width, height: PInteger): PByte; cdecl; external LIB_WEBP; function WebPDecodeBGRA(const data: PByte; data_size: Cardinal; width, height: PInteger): PByte; cdecl; external LIB_WEBP; function WebPDecodeARGB(const data: PByte; data_size: Cardinal; width, height: PInteger): PByte; cdecl; external LIB_WEBP; function WebPDecodeYUV(const data: PByte; data_size: Cardinal; width, height: PInteger; var u, v: PByte; stride, uv_stride: PInteger): PByte; cdecl; external LIB_WEBP; function WebPDecodeRGBInto(const data: PByte; data_size: Cardinal; output_buffer: PByte; output_buffer_size, output_stride: Integer): PByte; cdecl; external LIB_WEBP; function WebPDecodeRGBAInto(const data: PByte; data_size: Cardinal; output_buffer: PByte; output_buffer_size, output_stride: Integer): PByte; cdecl; external LIB_WEBP; function WebPDecodeBGRInto(const data: PByte; data_size: Cardinal; output_buffer: PByte; output_buffer_size, output_stride: Integer): PByte; cdecl; external LIB_WEBP; function WebPDecodeBGRAInto(const data: PByte; data_size: Cardinal; output_buffer: PByte; output_buffer_size, output_stride: Integer): PByte; cdecl; external LIB_WEBP; function WebPDecodeYUVInto(const data: PByte; data_size: Cardinal; luma: PByte; luma_size, luma_stride: Integer; u: PByte; u_size, u_stride: Integer; v: PByte; v_size, v_stride: Integer): PByte; cdecl; external LIB_WEBP; function WebPINew(mode: WEBP_CSP_MODE): PWebPIDecoder; cdecl; external LIB_WEBP; function WebPINewRGB(mode: WEBP_CSP_MODE; output_buffer: PByte; output_buffer_size, output_stride: Integer): PWebPIDecoder; cdecl; external LIB_WEBP; function WebPINewYUV(luma: PByte; luma_size, luma_stride: Integer; u: PByte; u_size, u_stride: Integer; v: PByte; v_size, v_stride: Integer): PWebPIDecoder; cdecl; external LIB_WEBP; procedure WebPIDelete(const idec: PWebPIDecoder); cdecl; external LIB_WEBP; function WebPIAppend(const idec: PWebPIDecoder; const data: PByte; data_size: Cardinal): TVP8StatusCode; cdecl; external LIB_WEBP; function WebPIUpdate(const idec: PWebPIDecoder; const data: PByte; data_size: Cardinal): TVP8StatusCode; cdecl; external LIB_WEBP; function WebPIDecGetRGB(const idec: PWebPIDecoder; last_y, width, height, stride: PInteger): PByte; cdecl; external LIB_WEBP; function WebPIDecGetYUV(const idec: PWebPIDecoder; last_y: PInteger; var u, v: PByte; width, height, stride, uv_stride: PInteger): PByte; cdecl; external LIB_WEBP; function VP8New: PWebPIDecoder; cdecl; external LIB_WEBP; function VP8InitIo(const io: PVP8Io): Integer; function VP8GetHeaders(const dec: PVP8Decoder; const io: PVP8Io): Integer; cdecl; external LIB_WEBP; function VP8Decode(const dec: PVP8Decoder; const io: PVP8Io): Integer; cdecl; external LIB_WEBP; function VP8Status(const dec: PVP8Decoder): TVP8StatusCode; cdecl; external LIB_WEBP; function VP8StatusMessage(const dec: PVP8Decoder): PAnsiChar; cdecl; external LIB_WEBP; procedure VP8Clear(const dec: PVP8Decoder); cdecl; external LIB_WEBP; procedure VP8Delete(const dec: PVP8Decoder); cdecl; external LIB_WEBP; function WebPGetEncoderVersion: Integer; cdecl; external LIB_WEBP; function WebPEncodeRGB(const rgb: PByte; width, height, stride: Integer; quality_factor: single; var output: PByte): Cardinal; cdecl; external LIB_WEBP; function WebPEncodeBGR(const bgr: PByte; width, height, stride: Integer; quality_factor: Single; var output: PByte): Cardinal; cdecl; external LIB_WEBP; function WebPEncodeRGBA(const rgba: PByte; width, height, stride: Integer; quality_factor: Single; var output: PByte): Cardinal; cdecl; external LIB_WEBP; function WebPEncodeBGRA(const bgra: PByte; width, height, stride: Integer; quality_factor: Single; var output: PByte): Cardinal; cdecl; external LIB_WEBP; function WebPEncodeLosslessRGB(const bgra: PByte; width, height, stride: Integer; var output: PByte): Cardinal; cdecl; external LIB_WEBP; function WebPEncodeLosslessBGR(const bgra: PByte; width, height, stride: Integer; var output: PByte): Cardinal; cdecl; external LIB_WEBP; function WebPEncodeLosslessRGBA(const bgra: PByte; width, height, stride: Integer; var output: PByte): Cardinal; cdecl; external LIB_WEBP; function WebPEncodeLosslessBGRA(const bgra: PByte; width, height, stride: Integer; var output: PByte): Cardinal; cdecl; external LIB_WEBP; function WebPConfigInit(const config: PWebPConfig): Integer; function WebPConfigPreset(const config: PWebPConfig; preset: TWebPPreset; quality: Single): Integer; function WebPValidateConfig(const config: PWebPConfig): Integer; cdecl; external LIB_WEBP; function WebPPictureInit(const picture: PWebPPicture): Integer; function WebPPictureAlloc(const picture: PWebPPicture): Integer; cdecl; external LIB_WEBP; procedure WebPPictureFree(const picture: PWebPPicture); cdecl; external LIB_WEBP; function WebPPictureCopy(const src, dst: PWebPPicture): Integer; cdecl; external LIB_WEBP; function WebPPictureCrop(const picture: PWebPPicture; left, top, width, height: Integer): Integer; cdecl; external LIB_WEBP; function WebPPictureImportRGB(const picture: PWebPPicture; const rgb: PByte; rgb_stride: Integer): Integer; cdecl; external LIB_WEBP; function WebPPictureImportRGBA(const picture: PWebPPicture; const rgba: PByte; rgba_stride: Integer): Integer; cdecl; external LIB_WEBP; function WebPPictureImportBGR(const picture: PWebPPicture; const bgr: PByte; bgr_stride: Integer): Integer; cdecl; external LIB_WEBP; function WebPPictureImportBGRA(const picture: PWebPPicture; const bgra: PByte; bgra_stride: Integer): Integer; cdecl; external LIB_WEBP; function WebPEncode(const config: PWebPConfig; const picture: PWebPPicture): Integer; cdecl; external LIB_WEBP; implementation function VP8InitIoInternal(const io: PVP8Io; bersion: Integer): Integer; cdecl; external LIB_WEBP; const WEBP_DECODER_ABI_VERSION = $0001; function VP8InitIo(const io: PVP8Io): Integer; begin Result := VP8InitIoInternal(io, WEBP_DECODER_ABI_VERSION); end; const WEBP_ENCODER_ABI_VERSION = $0001; function WebPConfigInitInternal(const conf: PWebPConfig; preset: TWebPPreset; quality: single; version: Integer): Integer; cdecl; external LIB_WEBP; function WebPConfigInit(const config: PWebPConfig): Integer; begin Result := WebPConfigInitInternal(config, WEBP_PRESET_DEFAULT, 75.0, WEBP_ENCODER_ABI_VERSION); end; function WebPConfigPreset(const config: PWebPConfig; preset: TWebPPreset; quality: Single): Integer; begin Result := WebPConfigInitInternal(config, preset, quality, WEBP_ENCODER_ABI_VERSION); end; function WebPPictureInitInternal(const picture: PWebPPicture; version: Integer): Integer; cdecl; external LIB_WEBP; function WebPPictureInit(const picture: PWebPPicture): Integer; begin Result := WebPPictureInitInternal(picture, WEBP_ENCODER_ABI_VERSION); end; end.unit Vcl.WebpImage; interface uses System.Math, System.Classes, System.SysUtils, System.Types, Vcl.Controls, libwebp, WebpHelpers, Winapi.GDIPAPI, Winapi.GDIPOBJ; type TWebpImage = class (TGraphicControl) private FBitmap: TGPBitmap; FData: PByte; FOffset: TPoint; FStretch: boolean; FCenter: boolean; FScale: real; FProportional: boolean; procedure SetOffset(const Value: TPoint); procedure SetCenter(const Value: boolean); procedure SetProportional(const Value: boolean); procedure SetScale(const Value: real); procedure SetStretch(const Value: boolean); published constructor Create(AOwner: TComponent); override; destructor Destroy; override; property Bitmap : TGPBitmap read FBitmap write FBitmap; property Stretch : boolean read FStretch write SetStretch; property Proportional : boolean read FProportional write SetProportional; property Center : boolean read FCenter write SetCenter; property Scale : real read FScale write SetScale; property Offset : TPoint read FOffset write SetOffset; procedure Paint; override; procedure LoadFromFile(filename: string); procedure LoadFromStream(stream : TStream); end; implementation { TWebpImage } constructor TWebpImage.Create(AOwner: TComponent); begin inherited; Bitmap := TGPBitmap.Create(); Stretch := false; Proportional := false; Scale := 1; Center := false; Offset := Point(0, 0); end; destructor TWebpImage.Destroy; begin Bitmap.Destroy; WebPFree(FData); inherited; end; procedure TWebpImage.LoadFromFile(filename: string); var fs : TFileStream; data : PByte; begin WebPFree(FData); fs := TFileStream.Create(filename, fmOpenRead); WebpDecode(fs, data, FBitmap); FData := data; fs.Free; Paint; end; procedure TWebpImage.LoadFromStream(stream: TStream); var data: PByte; begin WebPFree(FData); WebpDecode(stream, data, FBitmap); FData := data; Paint; end; procedure TWebpImage.Paint; var G : TGPGraphics; destRect, srcRect : TGPRect; begin inherited; destRect.X := 0; destRect.Y := 0; destRect.Width := Bitmap.GetWidth; destRect.Height := Bitmap.GetHeight; srcRect.X := 0; srcRect.Y := 0; srcRect.Width := Bitmap.GetWidth; srcRect.Height := Bitmap.GetHeight; if Stretch then begin destRect.Width := Width; destRect.Height := Height; end; destRect.Height := Floor(destRect.Height * Scale); destRect.Width := Floor(destRect.Width * Scale); if Stretch and Proportional then begin if (Height > 0) and (srcRect.Height > 0) then if (srcRect.Width / srcRect.Height) - (Width / Height) < 0 then destRect.Width := Floor(srcRect.Width * (destRect.Height / srcRect.Height)) else destRect.Height := Floor(srcRect.Height * (destRect.Width / srcRect.Width)) end; destRect.X := destRect.X - Offset.X; destRect.Y := destRect.Y - Offset.Y; if Center then begin destRect.X := Floor((Width / 2) - (destRect.Width / 2)); destRect.Y := Floor((Height / 2) - (destRect.Height / 2)); end; Canvas.Lock; try G := TGPGraphics.Create(Canvas.Handle); G.SetCompositingMode(CompositingModeSourceOver); G.SetInterpolationMode(InterpolationModeDefault); G.SetPixelOffsetMode(PixelOffsetModeHighQuality); G.SetSmoothingMode(SmoothingModeAntiAlias); G.DrawImage(bitmap, destRect, srcRect.x, srcRect.Y, srcRect.Width, srcRect.Height, UnitPixel); finally G.Free; end; Canvas.Unlock; end; procedure TWebpImage.SetCenter(const Value: boolean); begin FCenter := Value; if Parent <> nil then Paint end; procedure TWebpImage.SetOffset(const Value: TPoint); begin FOffset := Value; if Parent <> nil then Paint end; procedure TWebpImage.SetProportional(const Value: boolean); begin FProportional := Value; if Parent <> nil then Paint end; procedure TWebpImage.SetScale(const Value: real); begin FScale := Value; if Parent <> nil then Paint end; procedure TWebpImage.SetStretch(const Value: boolean); begin FStretch := Value; if Parent <> nil then Paint end; end.unit WebpHelpers; interface uses System.SysUtils, GDIPAPI, GDIPOBJ, System.Classes, libwebp; const gGIf: TGUID = '{557CF402-1A04-11D3-9A73-0000F81EF32E}'; gPNG: TGUID = '{557CF406-1A04-11D3-9A73-0000F81EF32E}'; gPJG: TGUID = '{557CF401-1A04-11D3-9A73-0000F81EF32E}'; gBMP: TGUID = '{557CF400-1A04-11D3-9A73-0000F81EF32E}'; gTIF: TGUID = '{557CF405-1A04-11D3-9A73-0000F81EF32E}'; procedure WebpEncode(var stream: TMemoryStream; img: TGPBitmap; quality_factor: Single = 80); overload; procedure WebpEncode(var buffer: TBytes; img: TGPBitmap; quality_factor: Single = 80); overload; procedure WebpLosslessEncode(var stream: TMemoryStream; img: TGPBitmap); overload; procedure WebpLosslessEncode(var buffer: TBytes; img: TGPBitmap); overload; procedure WebpDecode(fs: TStream; var data: PByte; var bitmap : TGPBitmap); function GetWebpVersionString (versionhex : integer) : string; implementation procedure WebpEncode(var stream: TMemoryStream; img: TGPBitmap; quality_factor: Single = 80); overload; var rect : TGPRect; bmpData: BitmapData; ptrEncoded : PByte; size: Cardinal; begin rect.X := 0; rect.Y := 0; rect.Width := img.GetWidth; rect.height := img.GetHeight; img.LockBits(rect, 3, img.GetPixelFormat, bmpData); if IsAlphaPixelFormat(img.GetPixelFormat) then size := WebPEncodeBGRA(bmpData.Scan0, img.GetWidth, img.GetHeight, bmpData.Stride, quality_factor, ptrEncoded) else size := WebPEncodeBGR(bmpData.Scan0, img.GetWidth, img.GetHeight, bmpData.Stride, quality_factor, ptrEncoded); stream.Write(ptrEncoded^, size); WebPFree(ptrEncoded); end; procedure WebpEncode(var buffer: TBytes; img: TGPBitmap; quality_factor: Single = 80); overload; var stream : TMemoryStream; begin stream := TMemoryStream.Create; WebpEncode(stream, img, quality_factor); stream.Position := 0; SetLength(buffer, stream.Size); stream.ReadData(buffer, stream.Size); stream.Free; end; procedure WebpLosslessEncode(var stream: TMemoryStream; img: TGPBitmap); overload; var rect : TGPRect; bmpData: BitmapData; ptrEncoded : PByte; size: Cardinal; begin rect.X := 0; rect.Y := 0; rect.Width := img.GetWidth; rect.height := img.GetHeight; img.LockBits(rect, 3, img.GetPixelFormat, bmpData); if IsAlphaPixelFormat(img.GetPixelFormat) then size := WebPEncodeLosslessBGRA(bmpData.Scan0, img.GetWidth, img.GetHeight, bmpData.Stride, ptrEncoded) else size := WebPEncodeLosslessBGR(bmpData.Scan0, img.GetWidth, img.GetHeight, bmpData.Stride, ptrEncoded); stream.Write(ptrEncoded^, size); WebPFree(ptrEncoded); end; procedure WebpLosslessEncode(var buffer: TBytes; img: TGPBitmap); overload; var stream : TMemoryStream; begin stream := TMemoryStream.Create; WebpLosslessEncode(stream, img); stream.Position := 0; SetLength(buffer, stream.Size); stream.ReadData(buffer, stream.Size); stream.Free; end; procedure WebpDecode(fs: TStream; var data: PByte; var bitmap : TGPBitmap); var buffer: TBytes; width, height: integer; begin fs.Position := 0; setlength(buffer, fs.Size); fs.ReadBuffer(buffer, fs.size); data := WebPDecodeBGRA(@buffer[0], fs.Size, @width, @height); setlength(buffer, 0); bitmap := TGPBitmap.Create(width, height, 4 * width, 2498570, data); end; function GetWebpVersionString (versionhex : integer) : string; var maj, min, patch : integer; begin maj := versionhex div $10000; min := (versionhex - (maj * $10000)) div $100; patch := (versionhex - (maj * $10000) - (min * $100)); result := maj.ToString + '.' + min.ToString + '.' + patch.ToString; end; end.

Semoga bermanfaat,