@@ -3,8 +3,8 @@ Attribute VB_Name = "Plugin_Heif"
33'libheif Library Interface
44'Copyright 2024-2024 by Tanner Helland
55'Created: 16/July/24
6- 'Last updated: 27 /August/24
7- 'Last update: add heif export support (single frame only for now)
6+ 'Last updated: 29 /August/24
7+ 'Last update: add support for exporting multi- frame images
88'
99'Per its documentation (available at https://github.com/strukturag/libheif), libheif is...
1010'
@@ -21,6 +21,20 @@ Attribute VB_Name = "Plugin_Heif"
2121' supply your own libheif copies in place of PD's default ones, but libheif and all supporting
2222' libraries obviously need to be built as x86 libraries for this to work (not x64).
2323'
24+ 'Note also that there are quite a few encoding parameters supported by libheif. Here are the
25+ ' encoding parameters reported by heif-enc (as listed via "./heif-enc.exe -P")
26+ ' Parameters for encoder `x265 HEVC encoder (3.5+39-931178347)`:
27+ ' quality, Default = 50, [0;100]
28+ ' lossless, Default = False
29+ ' preset, default=slow, { ultrafast,superfast,veryfast,faster,fast,medium,slow,slower,veryslow,placebo }
30+ ' tune, default=ssim, { psnr,ssim,grain,fastdecode }
31+ ' tu-intra-depth, Default = 2, [1;4]
32+ ' complexity, [0;100]
33+ ' chroma, default=420, { 420,422,444 }
34+ '
35+ 'PD could expose any of these to the user, but there are localization and usability
36+ ' considerations for these that I haven't fully considered (yet). Exposing these remains TBD.
37+ '
2438'Unless otherwise noted, all source code in this file is shared under a simplified BSD license.
2539' Full license details are available in the LICENSE.md file, or at https://photodemon.org/license/
2640'
@@ -49,6 +63,7 @@ Private Enum Libheif_ProcAddress
4963 heif_context_get_number_of_top_level_images
5064 heif_context_get_primary_image_ID
5165 heif_context_is_top_level_image_ID
66+ heif_encoder_list_parameters
5267 heif_encoder_release
5368 heif_image_get_plane
5469 heif_image_get_plane_readonly
@@ -433,6 +448,7 @@ Public Function InitializeEngine(ByRef pathToDLLFolder As String) As Boolean
433448 m_ProcAddresses(heif_context_get_number_of_top_level_images) = GetProcAddress(m_hLibHeif, "heif_context_get_number_of_top_level_images" )
434449 m_ProcAddresses(heif_context_get_primary_image_ID) = GetProcAddress(m_hLibHeif, "heif_context_get_primary_image_ID" )
435450 m_ProcAddresses(heif_context_is_top_level_image_ID) = GetProcAddress(m_hLibHeif, "heif_context_is_top_level_image_ID" )
451+ m_ProcAddresses(heif_encoder_list_parameters) = GetProcAddress(m_hLibHeif, "heif_encoder_list_parameters" )
436452 m_ProcAddresses(heif_encoder_release) = GetProcAddress(m_hLibHeif, "heif_encoder_release" )
437453 m_ProcAddresses(heif_image_get_plane) = GetProcAddress(m_hLibHeif, "heif_image_get_plane" )
438454 m_ProcAddresses(heif_image_get_plane_readonly) = GetProcAddress(m_hLibHeif, "heif_image_get_plane_readonly" )
@@ -1113,7 +1129,6 @@ Public Function PreviewHEIF(ByRef srcDIB As pdDIB, ByRef dstDIB As pdDIB, ByRef
11131129 ' (Refer to the above heif_context_encode_image to see a better way to handle this, pending fixes in libheif;
11141130 ' in anticipation of that bug-fix, I've left the required line of code below.)
11151131 Dim hImgDecoded As Long
1116- PDDebug.LogAction "Starting decode now..."
11171132 hReturn = PD_heif_decode_image(hImgAfter, hImgDecoded, heif_colorspace_RGB, heif_chroma_interleaved_RGBA, ByVal 0 &)
11181133 'hReturn = PD_heif_decode_image(hImgEncoded, hImgDecoded, heif_colorspace_RGB, heif_chroma_interleaved_RGBA, ByVal 0&)
11191134 If (hReturn.heif_error_code <> heif_error_Ok) Then
@@ -1201,22 +1216,23 @@ Public Function SaveHEIF_ToFile(ByRef srcImage As pdImage, ByRef srcOptions As S
12011216 Const FUNC_NAME As String = "SaveHEIF_ToFile"
12021217 SaveHEIF_ToFile = False
12031218
1204- 'Retrieve the composited pdImage object.
1205- Dim finalDIB As pdDIB
1206- srcImage.GetCompositedImage finalDIB, False
1207-
12081219 'Retrieve and validate parameters from incoming string.
12091220 Dim cParams As pdSerialize
12101221 Set cParams = New pdSerialize
12111222 cParams.SetParamString srcOptions
12121223
1213- Dim exportLossless As Boolean , exportQuality As Single
1224+ Dim exportLossless As Boolean , exportQuality As Single , exportMultipage As Boolean
12141225 exportLossless = cParams.GetBool("heif-lossless" , False , True )
12151226 exportQuality = cParams.GetLong("heif-lossy-quality" , 90 , True )
1227+ exportMultipage = cParams.GetBool("heif-multiframe" , False , True )
12161228
12171229 If (exportQuality < 0 ) Then exportQuality = 0
12181230 If (exportQuality > 100 ) Then exportQuality = 100
12191231
1232+ 'Retrieve the composited pdImage object (if exporting as a composite image)
1233+ Dim finalDIB As pdDIB
1234+ If (Not exportMultipage) Or (srcImage.GetNumOfLayers <= 1 ) Then srcImage.GetCompositedImage finalDIB, False
1235+
12201236 'Create a new heif context
12211237 Dim ctxHeif As Long
12221238 ctxHeif = CallCDeclW(heif_context_alloc, vbLong)
@@ -1253,74 +1269,131 @@ Public Function SaveHEIF_ToFile(ByRef srcImage As pdImage, ByRef srcOptions As S
12531269 End If
12541270 End If
12551271
1256- 'Construct a heif image
1257- Dim hImg As Long
1258- hReturn = PD_heif_image_create(finalDIB.GetDIBWidth, finalDIB.GetDIBHeight, heif_colorspace_RGB, heif_chroma_interleaved_RGBA, VarPtr(hImg))
1259- If (hReturn.heif_error_code <> heif_error_Ok) Then
1260- hImg = 0
1261- InternalErrorHeif FUNC_NAME, hReturn
1262- GoTo SaveFailed
1263- End If
1272+ 'When exporting a multi-frame image, the handle to the encoded image representing the active layer
1273+ ' (if any) will be stored here. You do need to check the case of handle = 0, in case the active
1274+ ' layer is e.g. invisible.
1275+ Dim hActiveFrame As Long
12641276
1265- 'Allocate the heif image
1266- hReturn = PD_heif_image_add_plane(hImg, heif_channel_interleaved, finalDIB.GetDIBWidth, finalDIB.GetDIBHeight, 8 )
1267- If (hReturn.heif_error_code <> heif_error_Ok) Then
1268- InternalErrorHeif FUNC_NAME, hReturn
1269- GoTo SaveFailed
1270- End If
1271-
1272- CallCDeclW heif_image_set_premultiplied_alpha, vbEmpty, hImg, IIf (finalDIB.GetAlphaPremultiplication, 1 &, 0 &)
1273-
1274- 'Retrieve a pointer to the allocated image, as well as the stride (libheif doesn't necessarily guarantee
1275- ' a specific line alignment).
1276- Dim imgStride As Long , pData As Long
1277- pData = CallCDeclW(heif_image_get_plane, vbLong, hImg, heif_channel_interleaved, VarPtr(imgStride))
1278- If (pData = 0 ) Then
1279- InternalError FUNC_NAME, "bad pixel pointer"
1280- GoTo SaveFailed
1277+ 'This function can iterate layers and export each one as a unique frame in the target HEIF.
1278+ Dim idxStart As Long , idxEnd As Long
1279+ If exportMultipage Then
1280+ idxStart = 0
1281+ idxEnd = srcImage.GetNumOfLayers - 1
1282+ Else
1283+ idxStart = -1
1284+ idxEnd = -1
12811285 End If
12821286
1283- 'Fill the destination image line-by-line
1284- Dim imgHeight As Long , imgWidthBytes As Long
1285- imgHeight = finalDIB.GetDIBHeight
1286- imgWidthBytes = finalDIB.GetDIBStride
1287-
1288- Dim dstPixels() As Byte , dstSA1D As SafeArray1D , srcPixels() As Byte , srcSA1D As SafeArray1D
1289- Dim r As Long , g As Long , b As Long , a As Long
1290-
1291- Dim x As Long , y As Long
1292- For y = 0 To imgHeight - 1
1293- finalDIB.WrapArrayAroundScanline srcPixels, srcSA1D, y
1294- VBHacks.WrapArrayAroundPtr_Byte dstPixels, dstSA1D, pData + (imgStride * y), imgStride
1295- For x = 0 To imgWidthBytes - 1 Step 4
1287+ Dim i As Long
1288+ For i = idxStart To idxEnd
12961289
1297- 'Manually un-interleave to fix pixel order
1298- dstPixels(x) = srcPixels(x + 2 )
1299- dstPixels(x + 1 ) = srcPixels(x + 1 )
1300- dstPixels(x + 2 ) = srcPixels(x)
1301- dstPixels(x + 3 ) = srcPixels(x + 3 )
1290+ 'During multipage export, grab a copy of each target layer in turn
1291+ If (i >= 0 ) Then
1292+
1293+ If (finalDIB Is Nothing ) Then Set finalDIB = New pdDIB
1294+
1295+ 'Account for affine transforms in the current layer, as necessary
1296+ If srcImage.GetLayerByIndex(i).AffineTransformsActive(True ) Then
1297+ srcImage.GetLayerByIndex(i).GetAffineTransformedDIB finalDIB, 0 , 0
1298+ Else
1299+ finalDIB.CreateFromExistingDIB srcImage.GetLayerByIndex(i).GetLayerDIB
1300+ End If
1301+
1302+ End If
13021303
1303- Next x
1304- Next y
1305-
1306- VBHacks.UnwrapArrayFromPtr_Byte dstPixels
1307- finalDIB.UnwrapArrayFromDIB srcPixels
1308-
1309- 'Encode the image. Note that the final parameter of this call can return a handle to the encoded object.
1310- ' This would be useful for previews! For now, however, we just want to leave the image in the context,
1311- ' because it's about to be written out to file.
1312- hReturn = PD_heif_context_encode_image(ctxHeif, hImg, pHeifEncoder, 0 &, ByVal 0 &)
1313- If (hReturn.heif_error_code <> heif_error_Ok) Then
1314- InternalErrorHeif FUNC_NAME, hReturn
1315- GoTo SaveFailed
1316- End If
1317-
1318- If HEIF_DEBUG_VERBOSE Then PDDebug.LogAction "HEIF encoding complete"
1304+ 'Construct a heif image
1305+ Dim hImg As Long
1306+ hReturn = PD_heif_image_create(finalDIB.GetDIBWidth, finalDIB.GetDIBHeight, heif_colorspace_RGB, heif_chroma_interleaved_RGBA, VarPtr(hImg))
1307+ If (hReturn.heif_error_code <> heif_error_Ok) Then
1308+ hImg = 0
1309+ InternalErrorHeif FUNC_NAME, hReturn
1310+ GoTo SaveFailed
1311+ End If
1312+
1313+ 'Allocate the heif image
1314+ hReturn = PD_heif_image_add_plane(hImg, heif_channel_interleaved, finalDIB.GetDIBWidth, finalDIB.GetDIBHeight, 8 )
1315+ If (hReturn.heif_error_code <> heif_error_Ok) Then
1316+ InternalErrorHeif FUNC_NAME, hReturn
1317+ GoTo SaveFailed
1318+ End If
1319+
1320+ CallCDeclW heif_image_set_premultiplied_alpha, vbEmpty, hImg, IIf (finalDIB.GetAlphaPremultiplication, 1 &, 0 &)
1321+
1322+ 'Retrieve a pointer to the allocated image, as well as the stride (libheif doesn't necessarily guarantee
1323+ ' a specific line alignment).
1324+ Dim imgStride As Long , pData As Long
1325+ pData = CallCDeclW(heif_image_get_plane, vbLong, hImg, heif_channel_interleaved, VarPtr(imgStride))
1326+ If (pData = 0 ) Then
1327+ InternalError FUNC_NAME, "bad pixel pointer"
1328+ GoTo SaveFailed
1329+ End If
1330+
1331+ 'Fill the destination image line-by-line
1332+ Dim imgHeight As Long , imgWidthBytes As Long
1333+ imgHeight = finalDIB.GetDIBHeight
1334+ imgWidthBytes = finalDIB.GetDIBStride
1335+
1336+ Dim dstPixels() As Byte , dstSA1D As SafeArray1D , srcPixels() As Byte , srcSA1D As SafeArray1D
1337+ Dim r As Long , g As Long , b As Long , a As Long
1338+
1339+ Dim x As Long , y As Long
1340+ For y = 0 To imgHeight - 1
1341+ finalDIB.WrapArrayAroundScanline srcPixels, srcSA1D, y
1342+ VBHacks.WrapArrayAroundPtr_Byte dstPixels, dstSA1D, pData + (imgStride * y), imgStride
1343+ For x = 0 To imgWidthBytes - 1 Step 4
1344+
1345+ 'Manually un-interleave to fix pixel order
1346+ dstPixels(x) = srcPixels(x + 2 )
1347+ dstPixels(x + 1 ) = srcPixels(x + 1 )
1348+ dstPixels(x + 2 ) = srcPixels(x)
1349+ dstPixels(x + 3 ) = srcPixels(x + 3 )
1350+
1351+ Next x
1352+ Next y
1353+
1354+ VBHacks.UnwrapArrayFromPtr_Byte dstPixels
1355+ finalDIB.UnwrapArrayFromDIB srcPixels
1356+
1357+ 'Encode the image. Note that the final parameter of this call can return a handle to the encoded object.
1358+ Dim hImgEncoded As Long
1359+ hReturn = PD_heif_context_encode_image(ctxHeif, hImg, pHeifEncoder, 0 &, hImgEncoded)
1360+ If (hReturn.heif_error_code <> heif_error_Ok) Then
1361+ InternalErrorHeif FUNC_NAME, hReturn
1362+ GoTo SaveFailed
1363+ End If
1364+
1365+ 'Now that the image is encoded, we can free the raw image.
1366+ CallCDeclW heif_image_release, vbEmpty, hImg
1367+ hImg = 0
1368+
1369+ 'In multi-frame images, we need to manually set the active frame (if any)
1370+ If (i >= 0 ) Then
1371+
1372+ 'If the active frame is visible, it can cause problems, so ensure a failsafe handle is grabbed
1373+ If (hActiveFrame = 0 ) Then hActiveFrame = hImgEncoded
1374+
1375+ 'With the backup case covered, use the currently active layer (if any) as the active frame
1376+ If (i = srcImage.GetActiveLayerIndex) Then hActiveFrame = hImgEncoded
1377+
1378+ End If
1379+
1380+ If HEIF_DEBUG_VERBOSE Then PDDebug.LogAction "HEIF encoding complete"
1381+
1382+ NextLayer:
1383+ Next i
13191384
13201385 'Free the encoder
13211386 CallCDeclW heif_encoder_release, vbEmpty, pHeifEncoder
13221387 pHeifEncoder = 0
13231388
1389+ 'If encoding multi-frame images, set the active frame now
1390+ If (hActiveFrame <> 0 ) Then
1391+ hReturn = PD_heif_context_set_primary_image(ctxHeif, hActiveFrame)
1392+ If (hReturn.heif_error_code <> heif_error_Ok) Then
1393+ InternalError FUNC_NAME, "heif_context_set_primary_image failed; base layer will be used instead"
1394+ End If
1395+ End If
1396+
13241397 'Dump to file
13251398 Dim utfFilename() As Byte , utfLen As Long
13261399 Files.FileDeleteIfExists dstFile
@@ -1331,10 +1404,6 @@ Public Function SaveHEIF_ToFile(ByRef srcImage As pdImage, ByRef srcOptions As S
13311404 GoTo SaveFailed
13321405 End If
13331406
1334- 'Free the raw image? The docs are ambiguous on whether we can do it earlier...
1335- CallCDeclW heif_image_release, vbEmpty, hImg
1336- hImg = 0
1337-
13381407 'Free the context
13391408 CallCDeclW heif_context_free, vbEmpty, ctxHeif
13401409 ctxHeif = 0
0 commit comments