Сохранение анимированных GIF

Пример загружает 4 изображения формата PNG и сохраняет в анимированный GIF файл. Я не смог добиться сохранения прозрачной анимации. Может и есть какой секрет, но я его не нашел.

Платформа: Windows (тестировал на Windows 7)
Автор: Станислав Будинов

MultiFrame.gif

#INCLUDE "windows.bi"
#INCLUDE "win/gdiplus.bi"
#INCLUDE "crt.bi"

Dim As Guid EncoderSaveFlag = Type(&h292266fc,&hac40,&h47bf,{&h8c, &hfc, &ha8, &h5b, &h89, &ha6, &h55, &hde})

Using GDIPLUS
Dim GDIPLUSSTARTUPINPUT As GDIPLUSSTARTUPINPUT
Dim As ULONG_PTR gdiplusToken
Dim Shared As GPIMAGE Ptr page(1 To 4)

GDIPLUSSTARTUPINPUT.GdiplusVersion = 1
If (GdiplusStartup(@gdiplusToken, @GDIPLUSSTARTUPINPUT, NULL) <> 0) Then
    Print "FAIL"
Endif

Function GetEncoderClsid(format_ As Wstring Ptr , Byref pClsid As CLSID Ptr ) As Integer

    Dim As UINT  num
    Dim As UINT  size

    Dim As ImageCodecInfo Ptr pImageCodecInfo

    GdipGetImageEncodersSize(@num, @size)
    If(size = 0) Then Return -1

    pImageCodecInfo = Allocate(size)
    If pImageCodecInfo = NULL Then Return -1


    GdipGetImageEncoders(num, size, pImageCodecInfo)

    For j As Uinteger = 0 To num-1
        If wcscmp(pImageCodecInfo[j].MimeType, format_) = 0  Then
            *pClsid = pImageCodecInfo[j].Clsid
            Deallocate(pImageCodecInfo)
            Return j
        Endif
    Next

    Deallocate(pImageCodecInfo)
    Return -1
End Function


Dim As CLSID encoderClsid
GetEncoderClsid(Wstr("image/gif"), @encoderClsid)

For i As Integer = 1 To 4
    If (GdipLoadImageFromFile(Wstr(i & ".png"), @page(i)) <> 0) Then
        Print "FAIL"
    Endif
Next


Dim item As PROPERTYITEM
Dim lDelays(3) As Long = {30,30,30,30} ' время для каждого кадра
item.ID = PropertyTagFrameDelay
item.length = (Ubound(lDelays) - Lbound(lDelays) + 1) * 4
item.Type = PropertyTagTypeSLONG
item.Value = @lDelays(0)
GdipSetPropertyItem(page(1), @item)

Dim iProperties(1) As Integer = {9} '- 10 циклов 
item.ID = PropertyTagLoopCount
item.length = 2
item.Type = PropertyTagTypeShort
item.Value = @iProperties(0)
GdipSetPropertyItem(page(1), @item)


Dim As EncoderParameters encoderParameters
Dim As Ulong parameterValue
encoderParameters.Count = 1
encoderParameters.Parameter(0).Guid = EncoderSaveFlag
encoderParameters.Parameter(0).Type = EncoderParameterValueTypeLong
encoderParameters.Parameter(0).NumberOfValues = 1
encoderParameters.Parameter(0).Value = @parameterValue

parameterValue = EncoderValueMultiFrame
If (GdipSaveImageToFile(page(1), Wstr("MultiFrame.gif"), @encoderClsid, @encoderParameters) = 0) Then
    Print "Page 1 saved successfully."
Endif

For i As Integer = 2 To 4
    parameterValue = EncoderValueFrameDimensionTime
    If GdipSaveAddImage(page(1),page(i) , @encoderParameters) = 0 Then
        Print "Page " & i & " saved successfully."
    Endif
    GdipDisposeImage page(i)
Next

parameterValue = EncoderValueFlush
If GdipSaveAdd(page(1),@encoderParameters) = 0 Then Print "File closed successfully."
GdipDisposeImage page(1)
GdiplusShutdown gdiplusToken
Sleep


Весь проект с изображениями можно скачать ниже:

Скачать