libwebp WEBP image decoder and encoder support for many other formats also.

[D.J.Peters]

Normaly I would add the webp image format (with heigh compression rates) to library fbimage
but the WEBP SDK self is a complete image library with many decoders and encoders.

input formats: WebP, JPEG, PNG, PNM (PGM, PPM, PAM)
output formats: WebP, PNG PAM (PGM, PPM, PAM) PGM16 BMP TIFF YUV ALPHA

homepage: https://developers.google.com/speed/webp
souce tree: https://chromium.googlesource.com/webm/libwebp

The latest (v1.5) command line tools as windows 64 binarys:
https://storage.googleapis.com/download ... no-wic.zip

The older (v1.0.3) but full working windows 32 binarys:
https://storage.googleapis.com/download ... no-wic.zip

FreeBASIC:
download library: libwebp-v1.5.zip

download souce code: libwebp-v1.5-src.zip with Code::Blocks project.

Happy coding.

Joshy

[UEZ]

Thanks for sharing it. I was too lazy to do it.

[D.J.Peters]

It's easy to encode or decode any kind of pixel buffers like the FB Image
but to decode/encode the webp image format from or to a file looks more
complicated it works with the muxer/demuxer I search for an example.

The open source webp format will replace the animated GIF format also.

Joshy

[UEZ]

This is an example I wrote some years ago:

Code: Select all

#ifdef __FB_64BIT__
	#inclib "webp_x64"
    #inclib "gdiplus"
    #include once "win/gdiplus-c.bi"
#else
	#inclib "webp_x86"
    #include once "win/gdiplus.bi"
    Using Gdiplus
#endif

#include "encode.bi"

Dim Shared gdipToken As ULONG_PTR
Dim Shared GDIp As GdiplusStartupInput 

Private Function _GDIPlus_Startup() As BOOL
	GDIp.GdiplusVersion = 1
	If GdiplusStartup(@gdipToken, @GDIp, NULL) <> 0 Then
		Error 1
		Return False
	EndIf
	Return True
End Function

Private Sub _GDIPlus_Shutdown()
	GdiplusShutdown(gdipToken)
End Sub

Function WebP_CreateWebPAdvancedFromBitmap(ByVal filename As ZString Ptr, ByVal hBitmap As Any Ptr, ByVal WebPPreset As Long = WEBP_HINT_DEFAULT, _
										   ByVal lossless As Long = 0, ByVal quality As Single = 100, ByVal method As Long = 6, ByVal sns_strength As Long = 0, _
										   ByVal filter_sharpness As Long = 0, ByVal filter_strength As Long = 1, ByVal pass As Long = 10, ByVal level As Long = 6) As Long Export
	
	If _GDIPlus_Startup() = False Then Return -1
	Dim As Single w, h
	Dim As Integer iStatus = GdipGetImageDimension(hBitmap, @w, @h)
	If iStatus <> 0 OrElse w < 1 OrElse h < 1 OrElse w > WEBP_MAX_DIMENSION OrElse h > WEBP_MAX_DIMENSION Then 
		_GDIPlus_Shutdown()
		Return -2
	EndIf
	
	Dim As WebPConfig config
	If WebPConfigInitInternal(@config, WebPPreset, quality, WEBP_ENCODER_ABI_VERSION) = 0 Then Return -3
	If lossless Then 
		level = IIf(level < 0, 0, IIf(level > 9, 9, level))
		If WebPConfigLosslessPreset(@config, level) = 0 Then Return -4
	EndIf
	
'	With config
'	? "method " & .method
'	? "sns_strength " & .sns_strength
'	? "filter_sharpness " & .filter_sharpness
'	? "filter_strength " & .filter_strength
'	? "pass " & .pass
'	? "segments " & .segments
'	? "filter_type " & .filter_type
'	? "autofilter " & .autofilter
'	? "alpha_compression " & .alpha_compression
'	? "alpha_filtering "  & .alpha_filtering
'	? "alpha_quality " & .alpha_quality
'	? "thread_level " & .thread_level
'	? "use_sharp_yuv " & .use_sharp_yuv
'	? "near_lossless " & .near_lossless
'	? "exact " & .exact
'	End With
	
	
	With config
		.lossless = IIf(lossless < 0, 0, IIf(lossless > 1, 1, lossless))
		.quality = IIf(quality < 0, 0, IIf(quality > 100, 100, quality))
		.method = IIf(method < 0, 0, IIf(method > 6, 6, method))
		.sns_strength = IIf(sns_strength < 0, 0, IIf(sns_strength > 100, 100, sns_strength)) 
		.filter_sharpness = IIf(filter_sharpness < 0, 0, IIf(filter_sharpness > 7, 7, filter_sharpness))
		.filter_strength = IIf(filter_strength < 0, 0, IIf(filter_strength > 100, 100, filter_strength))
		.pass = IIf(pass < 1, 1, IIf(pass > 10, 10, pass))
		.segments = 4
		.filter_type = 1
		.autofilter = 1
		.alpha_compression = 1
		.alpha_filtering = 2
		.alpha_quality = 1
		.thread_level = 1
		.use_sharp_yuv = 1
'		.exact = 0
'		.emulate_jpeg_size = 1
		.target_size = 0
		.target_PSNR = 0
		.preprocessing = 2
		.partition_limit = 50
		.near_lossless = 0
	End With
	
	If WebPValidateConfig(@config) = 0 Then Return -5

	Dim As WebPAuxStats stats
	Dim As WebPPicture pic
	If WebPPictureInitInternal(@pic, WEBP_ENCODER_ABI_VERSION) = 0 Then	Return -6
	With pic
		.Width = w
		.height = h
		.use_argb = lossless
		.stats = @stats
	End With

	Dim As WebPMemoryWriter writer
	With pic
		.writer = Cast(WebPWriterFunction, @WebPMemoryWrite)
		.custom_ptr = @writer
	End With
	WebPMemoryWriterInit(@writer)
	
	Dim As RECT tRect = Type(0, 0, w - 1, h - 1)
	Dim As BitmapData tBitmapData
	GdipBitmapLockBits(hBitmap, Cast(Any Ptr, @tRect), ImageLockModeRead, PixelFormat32bppARGB, @tBitmapData)
	WebPPictureImportBGRA(@pic, tBitmapData.Scan0, tBitmapData.Stride)
	
	Dim As Long ret = WebPEncode(@config, @pic)
	
	GdipBitmapUnlockBits(hBitmap, @tBitmapData)
	_GDIPlus_Shutdown()
	If ret = 0 Then
		WebPPictureFree(@pic)
		WebPMemoryWriterClear(@writer)
		WebPFree(writer.mem)
		Return -7
	End If

	Dim As Integer hFile
	hFile = FreeFile()
	Open *filename For Binary Access Write As #hFile
	Put #hFile, 0, writer.mem[0], writer.size
	Close #hFile

	? "Output size: " & writer.size
	'MessageBoxEx(Null, "Size = " & Str(writer.max_size) & ", pMem = " & Str(writer.mem), "Debug", MB_ICONINFORMATION Or MB_OK Or MB_APPLMODAL Or MB_TOPMOST, 1033)
	WebPPictureFree(@pic)
	WebPMemoryWriterClear(@writer)
	WebPFree(writer.mem)
	Return 1
End Function

_GDIPlus_Startup()
Dim As Any Ptr hBitmap 
GdipLoadImageFromFile(WStr("c:\Temp\CSV.png"), @hBitmap)
? WebP_CreateWebPAdvancedFromBitmap("C:\Temp\CSV.webp", hBitmap, 0, 1, 100, 6)
GdipDisposeImage(hBitmap)
_GDIPlus_Shutdown()
Sleep

encode.bi

Code: Select all

#Pragma Once

Extern "C"

#Define WEBP_WEBP_ENCODE_H_
#Define WEBP_WEBP_TYPES_H_
'' TODO: #Define WEBP_INLINE inline
'' TODO: # define WEBP_EXTERN Extern __attribute__ ((visibility ("default")))
#Define WEBP_ABI_IS_INCOMPATIBLE(a, b) 	(((a) Shr 8) <> ((b) Shr 8))
#Define WEBP_ENCODER_ABI_VERSION 	&h020e

Declare Function WebPGetEncoderVersion() As Long
Declare Function WebPEncodeRGB(Byval Rgb As Const Ubyte Ptr, Byval Width As Long, Byval height As Long, Byval stride As Long, Byval quality_factor As Single, Byval Output As Ubyte Ptr Ptr) As Uinteger
Declare Function WebPEncodeBGR(Byval bgr As Const Ubyte Ptr, Byval Width As Long, Byval height As Long, Byval stride As Long, Byval quality_factor As Single, Byval Output As Ubyte Ptr Ptr) As Uinteger
Declare Function WebPEncodeRGBA(Byval Rgba As Const Ubyte Ptr, Byval Width As Long, Byval height As Long, Byval stride As Long, Byval quality_factor As Single, Byval Output As Ubyte Ptr Ptr) As Uinteger
Declare Function WebPEncodeBGRA(Byval bgra As Const Ubyte Ptr, Byval Width As Long, Byval height As Long, Byval stride As Long, Byval quality_factor As Single, Byval Output As Ubyte Ptr Ptr) As Uinteger
Declare Function WebPEncodeLosslessRGB(Byval Rgb As Const Ubyte Ptr, Byval Width As Long, Byval height As Long, Byval stride As Long, Byval Output As Ubyte Ptr Ptr) As Uinteger
Declare Function WebPEncodeLosslessBGR(Byval bgr As Const Ubyte Ptr, Byval Width As Long, Byval height As Long, Byval stride As Long, Byval Output As Ubyte Ptr Ptr) As Uinteger
Declare Function WebPEncodeLosslessRGBA(Byval Rgba As Const Ubyte Ptr, Byval Width As Long, Byval height As Long, Byval stride As Long, Byval Output As Ubyte Ptr Ptr) As Uinteger
Declare Function WebPEncodeLosslessBGRA(Byval bgra As Const Ubyte Ptr, Byval Width As Long, Byval height As Long, Byval stride As Long, Byval Output As Ubyte Ptr Ptr) As Uinteger
Declare Sub WebPFree(Byval Ptr As Any Ptr)

Type WEBP_CSP_MODE As Long
Enum
	MODE_RGB = 0
	MODE_RGBA = 1
	MODE_BGR = 2
	MODE_BGRA = 3
	MODE_ARGB = 4
	MODE_RGBA_4444 = 5
	MODE_RGB_565 = 6
	MODE_rgbA2 = 7
	MODE_bgrA2 = 8
	MODE_Argb2 = 9
	MODE_rgbA2_4444 = 10
	MODE_YUV = 11
	MODE_YUVA = 12
	MODE_LAST = 13
End Enum

Type WebPImageHint As Long
Enum
	WEBP_HINT_DEFAULT = 0
	WEBP_HINT_PICTURE
	WEBP_HINT_PHOTO
	WEBP_HINT_GRAPH
	WEBP_HINT_LAST
End Enum

Type WebPConfig
	lossless As Long
	quality As Single
	method As Long
	image_hint As WebPImageHint
	target_size As Long
	target_PSNR As Single
	segments As Long
	sns_strength As Long
	filter_strength As Long
	filter_sharpness As Long
	filter_type As Long
	autofilter As Long
	alpha_compression As Long
	alpha_filtering As Long
	alpha_quality As Long
	pass As Long
	show_compressed As Long
	preprocessing As Long
	partitions As Long
	partition_limit As Long
	emulate_jpeg_size As Long
	thread_level As Long
	low_memory As Long
	near_lossless As Long
	exact As Long
	use_delta_palette As Long
	use_sharp_yuv As Long
	pad(0 To 1) As Ulong
End Type

Type WebPPreset As Long
Enum
	WEBP_PRESET_DEFAULT = 0
	WEBP_PRESET_PICTURE
	WEBP_PRESET_PHOTO
	WEBP_PRESET_DRAWING
	WEBP_PRESET_ICON
	WEBP_PRESET_TEXT
End Enum

Declare Function WebPConfigInitInternal(Byval As WebPConfig Ptr, Byval As WebPPreset, Byval As Single, Byval As Long) As Long
#Define WebPConfigInit(config) Clng(WebPConfigInitInternal((config), WEBP_PRESET_DEFAULT, 75.f, WEBP_ENCODER_ABI_VERSION))
#Define WebPConfigPreset(config, preset, quality) Clng(WebPConfigInitInternal((config), (preset), (quality), WEBP_ENCODER_ABI_VERSION))
Declare Function WebPConfigLosslessPreset(Byval config As WebPConfig Ptr, Byval level As Long) As Long
Declare Function WebPValidateConfig(Byval config As Const WebPConfig Ptr) As Long

Type WebPAuxStats
	coded_size As Long
	PSNR(0 To 4) As Single
	block_count(0 To 2) As Long
	header_bytes(0 To 1) As Long
	residual_bytes(0 To 2, 0 To 3) As Long
	segment_size(0 To 3) As Long
	segment_quant(0 To 3) As Long
	segment_level(0 To 3) As Long
	alpha_data_size As Long
	layer_data_size As Long
	lossless_features As Ulong
	histogram_bits As Long
	transform_bits As Long
	cache_bits As Long
	palette_size As Long
	lossless_size As Long
	lossless_hdr_size As Long
	lossless_data_size As Long
	pad(0 To 1) As Ulong
End Type

Type WebPPicture As WebPPicture_
Type WebPWriterFunction As Function(Byval Data As Const Ubyte Ptr, Byval data_size As Uinteger, Byval picture As Const WebPPicture Ptr) As Long

Type WebPMemoryWriter
	mem As Ubyte Ptr
	size As Uinteger
	max_size As Uinteger
	pad(0 To 0) As Ulong
End Type

Declare Sub WebPMemoryWriterInit(Byval writer As WebPMemoryWriter Ptr)
Declare Sub WebPMemoryWriterClear(Byval writer As WebPMemoryWriter Ptr)
Declare Function WebPMemoryWrite(Byval Data As Const Ubyte Ptr, Byval data_size As Uinteger, Byval picture As Const WebPPicture Ptr) As Long
Type WebPProgressHook As Function(Byval percent As Long, Byval picture As Const WebPPicture Ptr) As Long

Type WebPEncCSP As Long
Enum
	WEBP_YUV420 = 0
	WEBP_YUV420A = 4
	WEBP_CSP_UV_MASK = 3
	WEBP_CSP_ALPHA_BIT = 4
End Enum

Type WebPEncodingError As Long
Enum
	VP8_ENC_OK = 0
	VP8_ENC_ERROR_OUT_OF_MEMORY
	VP8_ENC_ERROR_BITSTREAM_OUT_OF_MEMORY
	VP8_ENC_ERROR_NULL_PARAMETER
	VP8_ENC_ERROR_INVALID_CONFIGURATION
	VP8_ENC_ERROR_BAD_DIMENSION
	VP8_ENC_ERROR_PARTITION0_OVERFLOW
	VP8_ENC_ERROR_PARTITION_OVERFLOW
	VP8_ENC_ERROR_BAD_WRITE
	VP8_ENC_ERROR_FILE_TOO_BIG
	VP8_ENC_ERROR_USER_ABORT
	VP8_ENC_ERROR_LAST
End Enum

Const WEBP_MAX_DIMENSION = 16383

Type WebPPicture_
	use_argb As Long
	colorspace As WebPEncCSP
	Width As Long
	height As Long
	y As Ubyte Ptr
	u As Ubyte Ptr
	v As Ubyte Ptr
	y_stride As Long
	uv_stride As Long
	a As Ubyte Ptr
	a_stride As Long
	pad1(0 To 1) As Ulong
	argb As Ulong Ptr
	argb_stride As Long
	pad2(0 To 2) As Ulong
	writer As WebPWriterFunction
	custom_ptr As Any Ptr
	extra_info_type As Long
	extra_info As Ubyte Ptr
	stats As WebPAuxStats Ptr
	error_code As WebPEncodingError
	progress_hook As WebPProgressHook
	user_data As Any Ptr
	pad3(0 To 2) As Ulong
	pad4 As Ubyte Ptr
	pad5 As Ubyte Ptr
	pad6(0 To 7) As Ulong
	memory_ As Any Ptr
	memory_argb_ As Any Ptr
	pad7(0 To 1) As Any Ptr
End Type

Declare Function WebPPictureInitInternal(Byval As WebPPicture Ptr, Byval As Long) As Long
#Define WebPPictureInit(picture) Clng(WebPPictureInitInternal((picture), WEBP_ENCODER_ABI_VERSION))
Declare Function WebPPictureAlloc(Byval picture As WebPPicture Ptr) As Long
Declare Sub WebPPictureFree(Byval picture As WebPPicture Ptr)
Declare Function WebPPictureCopy(Byval src As Const WebPPicture Ptr, Byval dst As WebPPicture Ptr) As Long
Declare Function WebPPlaneDistortion(Byval src As Const Ubyte Ptr, Byval src_stride As Uinteger, Byval ref As Const Ubyte Ptr, Byval ref_stride As Uinteger, Byval Width As Long, Byval height As Long, Byval x_step As Uinteger, 									  Byval Type As Long, Byval distortion As Single Ptr, Byval result As Single Ptr) As Long
Declare Function WebPPictureDistortion(Byval src As Const WebPPicture Ptr, Byval ref As Const WebPPicture Ptr, Byval metric_type As Long, Byval result As Single Ptr) As Long
Declare Function WebPPictureCrop(Byval picture As WebPPicture Ptr, Byval Left As Long, Byval top As Long, Byval Width As Long, Byval height As Long) As Long
Declare Function WebPPictureView(Byval src As Const WebPPicture Ptr, Byval Left As Long, Byval top As Long, Byval Width As Long, Byval height As Long, Byval dst As WebPPicture Ptr) As Long
Declare Function WebPPictureIsView(Byval picture As Const WebPPicture Ptr) As Long
Declare Function WebPPictureRescale(Byval pic As WebPPicture Ptr, Byval Width As Long, Byval height As Long) As Long
Declare Function WebPPictureImportRGB(Byval picture As WebPPicture Ptr, Byval Rgb As Const Ubyte Ptr, Byval rgb_stride As Long) As Long
Declare Function WebPPictureImportRGBA(Byval picture As WebPPicture Ptr, Byval Rgba As Const Ubyte Ptr, Byval rgba_stride As Long) As Long
Declare Function WebPPictureImportRGBX(Byval picture As WebPPicture Ptr, Byval rgbx As Const Ubyte Ptr, Byval rgbx_stride As Long) As Long
Declare Function WebPPictureImportBGR(Byval picture As WebPPicture Ptr, Byval bgr As Const Ubyte Ptr, Byval bgr_stride As Long) As Long
Declare Function WebPPictureImportBGRA(Byval picture As WebPPicture Ptr, Byval bgra As Const Ubyte Ptr, Byval bgra_stride As Long) As Long
Declare Function WebPPictureImportBGRX(Byval picture As WebPPicture Ptr, Byval bgrx As Const Ubyte Ptr, Byval bgrx_stride As Long) As Long
Declare Function WebPPictureARGBToYUVA(Byval picture As WebPPicture Ptr, Byval As WebPEncCSP) As Long
Declare Function WebPPictureARGBToYUVADithered(Byval picture As WebPPicture Ptr, Byval colorspace As WebPEncCSP, Byval dithering As Single) As Long
Declare Function WebPPictureSharpARGBToYUVA(Byval picture As WebPPicture Ptr) As Long
Declare Function WebPPictureSmartARGBToYUVA(Byval picture As WebPPicture Ptr) As Long
Declare Function WebPPictureYUVAToARGB(Byval picture As WebPPicture Ptr) As Long
Declare Sub WebPCleanupTransparentArea(Byval picture As WebPPicture Ptr)
Declare Function WebPPictureHasTransparency(Byval picture As Const WebPPicture Ptr) As Long
Declare Sub WebPBlendAlpha(Byval pic As WebPPicture Ptr, Byval background_rgb As Ulong)
Declare Function WebPEncode(Byval config As Const WebPConfig Ptr, Byval picture As WebPPicture Ptr) As Long

End Extern

Currently it works only with x86 - at least my version...

The files can be found also on my 1Drv: WebP

[srvaldez]

@UEZ

Code: Select all

#ifdef __FB_64BIT__
    #inclib "webp_x64"
    #inclib "sharpyuv_x64" ' <--- you need to add this line

[UEZ]

@UEZ

Code: Select all

#ifdef __FB_64BIT__
    #inclib "webp_x64"
    #inclib "sharpyuv_x64" ' <--- you need to add this line

Thanks - working now.