FreeBasic

В одной из своих статей, я показывал относительно простые способы воспроизведения GIF анимашек. Способ ниже дает более широкие возможности. Так разбив анимашку на отдельные кадры, можно отрисовать на них что-то дополнительно, изменить скорость воспроизведения а так же выбрать для проигрывания только нужные кадры.

GDI+ кодек отлично загружает прозрачные GIF. Чего конечно не скажешь о сохранении. Как я не пытался, но сохранить прозрачную анимашку GIF мне не удалось. Хотя непрозрачные кодек сохраняет. И через некоторое время я так же выложу пример сохранения.

В примере сделана отрисовка по таймеру, хоть это и не совсем правильно. Ведь анимашки могут иметь разный интервал ожидания между кадрами. Я попросту вынул временной интервал для первого кадра. Если нужно полноценнное воспроизведение, вы можете получить интервал ожидания для каждого кадра и проиграть кадры в отдельном потоке.

Для примера я взял вот эту анимашку:

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

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

Using GDIPLUS

Dim As Guid  FrameDimensionTime = Type(&h6AEDBD6D,&h3FB5,&h418A,{&h83, &ha6, &h7f, &h45, &h22, &h9d, &hc8, &h72})
Dim wc As WNDCLASSEX
Dim  msg As MSG
Dim GDIPLUSSTARTUPINPUT As GDIPLUSSTARTUPINPUT
Dim As ULONG_PTR gdiplusToken
Redim Shared As GPIMAGE Ptr page() ' массив с фреймами
Dim Shared As GPIMAGE Ptr Img ' хендл для загрузки изображения
Dim As GUID   pageGuid = FrameDimensionTime
Dim As GUID Ptr pDimensionIDs
Dim As CLSID  encoderClsid
Dim As UINT icount,_ ' кол-во размерностей (может быть для gif и не требуется)
iframeCount,_ ' кол-во фреймов в одной размерности
iframeCountAll,_  ' общее кол-во фреймов
iPos ' счетчик-смещение в массиве фреймов

' Инициализация GDI+
GDIPLUSSTARTUPINPUT.GdiplusVersion = 1
If (GdiplusStartup(@gdiplusToken, @GDIPLUSSTARTUPINPUT, NULL) <> 0) Then
    Print "FAIL"
Endif

' Загрузка фото
If (GdipLoadImageFromFile(Wstr("mushroom.gif"), @Img) <> 0) Then
    Print "FAIL"
    Sleep
    End
Endif

' Получение кол-ва размерностей
GdipImageGetFrameDimensionsCount(Img,@icount)
' Выделение памяти под Guid(ы)
pDimensionIDs = Allocate(Sizeof(GUID)*icount)
' Получение Guid(ов)
GdipImageGetFrameDimensionsList(Img,pDimensionIDs, icount)

For i As Integer = 1 To icount
    ' Получение кол-ва фремов в одном Guid
    GdipImageGetFrameCount(img, @pDimensionIDs[i-1],@iframecount)
    ' Складываем фреймы
    iframeCountAll = iframecount+iframeCountAll-1
    ' Пересоздаем массив
    Redim Preserve page(iframeCountAll)

    For j As Integer = 0 To iframecount-1
        ' Получаем текущий фрейм
        GdipImageSelectActiveFrame(img,@pageGuid, j)
        ' Копируем изображение в массив фреймов
        GdipCloneImage(img,@page(iPos))
        ' Увеличиваем счетчик
        iPos+=1

    Next

Next

' Проверяем, анимированный ли GIF
' Если нет, пишем что его нужно загружать
' с помощью обычных средств загрузки фото
If iframeCountAll = 0 Then
    Print "it is not animated gif"
    Print "Please load gif via GdipLoadImageFromFile"
    Sleep
    End
Endif

Dim item As PROPERTYITEM Ptr
Dim Shared iSleeptime As Integer ' время задержки между фреймами
Dim As Integer  size
' Получаем размер памяти под Property
GdipGetPropertyItemSize(page(0),PropertyTagFrameDelay,@size)
item = Allocate(size)
' Получаем время задержки первого фрейма
GdipGetPropertyItem(page(0),PropertyTagFrameDelay, size, Item)
iSleeptime = Peek(Item->value)*10
Deallocate (item)

' Рисуем как положено с двойной буферизацией
Sub OnPaint(hwnd As HWND, img As Any Ptr)
    Static iframe As Integer = 1
    Dim As PVOID GpGraphics,GpGraphics2 
    GdipGetImageGraphicsContext(img,@GpGraphics)
    GdipCreateFromHWND(hwnd,@GpGraphics2)
    GdipGraphicsClear(GpGraphics,&hffffff00)
    GdipDrawImage(GpGraphics,page(iframe),10,10)
    GdipDrawImage(GpGraphics2,img,0,0)
    GdipDeleteGraphics(GpGraphics)
    GdipDeleteGraphics(GpGraphics2)
    iframe+=1
    If iframe>Ubound(page) Then iframe = 0
End Sub

Function WndProc(hWnd As HWND,uMsg As UINT,wParam As WPARAM,lParam As LPARAM) As Integer
    Static As PVOID img 
    Select Case uMsg
        Case WM_CREATE
            GdipCreateBitmapFromScan0(125, 130 , NULL, PixelFormat32bppARGB, NULL, @img)
            SetTimer(hwnd,1,iSleeptime,0)
        Case WM_CLOSE
            GdipDisposeImage(img)
            PostQuitMessage(0)
        Case WM_TIMER
            OnPaint(hwnd, img)
        Case Else
            Return DefWindowProc(hWnd,uMsg,wParam,lParam)
    End Select
End Function

With wc
    .hInstance=GetModuleHandle(0)
    .cbSize=SizeOf(WNDCLASSEX)
    .style=CS_HREDRAW Or CS_VREDRAW
    .lpfnWndProc=@WndProc
    .lpszClassName=StrPtr("class")
    .hCursor=LoadCursor(NULL,IDC_ARROW)
End With

RegisterClassEx(@wc)
CreateWindowEx(0,wc.lpszClassName,"DrawGIF",WS_OVERLAPPEDWINDOW Or WS_VISIBLE,200,200,100,150,0,0,wc.hInstance,0)

While GetMessage(@msg,0,0,0)
    TranslateMessage(@msg)
    DispatchMessage(@msg)
Wend


Deallocate(pDimensionIDs)
For i As Integer = 0 To Ubound(page)
    GdipDisposeImage(page(i))
Next
GdipDisposeImage(img)
GdiplusShutdown gdiplusToken