[VB6] - View GIF animation.

Hello everyone! You can view the animation in any window that has a property "hWnd". Are also respected the speed and number of repetitions (as in the original GIF'e) are also important parameters are displayed on the screen. In principle, if a little more refined, you can shove in class and ready to work with animations at the object level. You can pause, play, and stop "in the beginning." Drawing made with "double-buffered", so that will not flicker. For use in the project, just plug and call the same methods, no additional control is not necessary, of course apart from the container.
Standart module:

Code:

---

Declaration  - see source.
...
' Локальные переменные уровня модуля
Dim mHwnd As Long, Init As Boolean, token As Long, img As Long, frames As Long, gr As Long, prevwndproc As Long
Dim tInit As Boolean, frame() As Long, loops As Long, index As Long, cycle As Long, isplay As Boolean
 
' Хендл окна в котором будем рисовать анимацию
Public Property Get hwnd() As Long
    hwnd = mHwnd
End Property
Public Property Let hwnd(ByVal value As Long)
    StopAnim                                                                                    ' Останавливаем анимацию
    If hwnd Then UnHook                                                                        ' Если до этого сабклассили, то отключаем сабклассинг
    mHwnd = value
    Hook                                                                                        ' Сабклассим новое окно
End Property
' Ширина кадра анимации
Public Property Get Width() As Long
    GdipGetImageWidth img, Width
End Property
' Высота кадра анимации
Public Property Get Height() As Long
    GdipGetImageHeight img, Height
End Property
' Текущий кадр
Public Property Get CurrentFrame() As Long
    CurrentFrame = index
End Property
' Количество кадров
Public Property Get FramesCount() As Long
    FramesCount = frames
End Property
' Сколько циклов анимации
Public Property Get LoopCount() As Long
    LoopCount = loops
End Property
' Проигрывается ли анимация
Public Property Get IsPlaying() As Boolean
    IsPlaying = isplay
End Property
' Загрузка файла анимации
Public Function LoadAnimation(ByVal FileName As String) As Boolean
    Dim GpInput As GdiplusStartupInput                                                          ' Для инициализации GDI+
    Dim pc As Long, sz As Long, pi As PropertyItem
    Dim buf() As Byte                                                                          ' Буффер для свойств
   
    If Not Init Then                                                                            ' Если не инициализирован GDI+
        GpInput.GdiplusVersion = 1
        If GdiplusStartup(token, GpInput) Then Exit Function Else Init = True                  ' Инициализируем, при неудаче выходим
    End If
    Clear                                                                                      ' Очистка, если до этого что-то загружали
    If GdipLoadImageFromFile(StrConv(FileName, vbUnicode), img) Then Exit Function              ' Загружаем картинку
    If GdipImageGetFrameCount(img, DEFINE_GUID(FrameDimensionTime), frames) Then                ' Проверяем кол-во кадров
        GdipDisposeImage img                                                                    ' При неудаче удаляем картинку и выходим (возможно что не GIF)
        Exit Function
    End If
    ' Узнаем время каждого кадра
    GdipGetPropertyItemSize img, PropertyTagFrameDelay, sz                                      ' Получаем размер свойства в байтах
    If sz > 0 And frames > 1 Then                                                              ' Имеет смысл только если кадров>1
        ReDim buf(sz - 1)                                                                      ' Выделяем буфер
        GdipGetPropertyItem img, PropertyTagFrameDelay, sz, buf(0)                              ' Копируем свойство в буфер
        CopyMemory pi, buf(0), Len(pi)                                                          ' Копируем в описатель
        ReDim frame(frames - 1)                                                                ' Выделяем кадровый буфер (длительности)
        CopyMemory frame(0), buf(Len(pi)), pi.Length                                            ' Копируем значения длительностей
    End If
    ' Узнаем зациклена ли анимация
    GdipGetPropertyItemSize img, PropertyTagLoopCount, sz
    If sz > 0 And frames > 1 Then
        ReDim buf(sz - 1)
        GdipGetPropertyItem img, PropertyTagLoopCount, sz, buf(0)
        CopyMemory pi, buf(0), Len(pi)
        GetMem2 buf(Len(pi)), loops
    End If
    index = 0: cycle = 0                                                                        ' Очистка счетчиков
    LoadAnimation = True                                                                        ' Успешно
End Function
' Проигрыш анимации
Public Function PlayAnim() As Boolean
    If Init And hwnd <> 0 And img <> 0 And Not isplay Then
        If frames > 1 Then                                                                      ' Смысл запускать таймер если кадров > 1
            If SetTimer(mHwnd, 1, frame(index) * 10, AddressOf TimerProc) = 0 Then _
                                                    Exit Function                              ' Не удалось запустить таймер
        End If
        tInit = True                                                                            ' Таймер инициализирован
        isplay = True                                                                          ' Включен проигрыш
        PlayAnim = True                                                                        ' Возвращаем успешное значение
        RedrawWindow mHwnd, ByVal 0, 0, RDW_INVALIDATE                                          ' Перерисовываем
    End If
End Function
' Пауза
Public Function Pause() As Boolean
    If isplay Then                                                                              ' Если играем
        isplay = False                                                                          ' то останавливаем
        Pause = True                                                                            ' Возвращаем успешное значение
        StopTimer                                                                              ' Останавливаем таймер
    End If
End Function
' Остановка анимации
Public Sub StopAnim()
    isplay = False                                                                              ' Останавливаем проигрывание
    index = 0                                                                                  ' Обнуляем текущий кадр
    cycle = 0                                                                                  ' Обнуляем счетчик циклов
    StopTimer                                                                                  ' Останавливаем таймер
    RedrawWindow mHwnd, ByVal 0, 0, RDW_INVALIDATE                                              ' Перерисовываем
End Sub
' Завершение работы
Public Sub ShutDown()
    Clear                                                                                      ' Очистка ресурсов
    If mHwnd Then UnHook                                                                        ' Если сабклассили то выключаем сабклассинг
    GdiplusShutdown token                                                                      ' Выключаем GDI+
End Sub
' Очистка ресурсов
Private Sub Clear()
    frames = 0                                                                                  ' Обнуляем количество кадров
    Erase frame()                                                                              ' Удаляем массив длительностей кадров
    If img Then GdipDisposeImage img                                                            ' Удаляем картинку
    StopAnim                                                                                    ' Останавливаем анимацию
End Sub
' Остановка таймера
Private Sub StopTimer()
    If tInit Then                                                                              ' Если таймер инициализирован
        KillTimer mHwnd, 1                                                                      ' Удаляем его
        tInit = False                                                                          ' Таймер не инициализирован
    End If
End Sub
' Из строки в GUID
Private Function DEFINE_GUID(ByVal sGuid As String) As CLSID
    Call CLSIDFromString(StrPtr(sGuid), DEFINE_GUID)                                            ' GUID из строкового параметра
End Function
' Сабклассинг
Private Sub Hook()
    prevwndproc = SetWindowLong(mHwnd, GWL_WNDPROC, AddressOf WndProc)                          ' Назначаем свою оконную процедуру
End Sub
Private Sub UnHook()
    SetWindowLong mHwnd, GWL_WNDPROC, prevwndproc                                              ' Возвращаем оконную процедуру
End Sub
' Оконная процедура
Private Function WndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim ps As PAINTSTRUCT, tdc As Long, tbmp As Long, obmp As Long, rc As RECT
    Select Case Msg
    Case WM_PAINT                                                                              ' Отрисовка
        If index = -1 Or Not Init Then
            WndProc = CallWindowProc(prevwndproc, hwnd, Msg, wParam, lParam)                    ' Если нет активной анимации рисуем как было
        Else
            ' Для предотвращения мерцания, например анимаций с черным фоном, я решилл использовать двойную буфферизацию
            GetClientRect hwnd, rc                                                              ' Узнаем размер ко контрола
            BeginPaint hwnd, ps
            tdc = CreateCompatibleDC(ps.hdc)                                                    ' Буфферный DC
            tbmp = CreateCompatibleBitmap(ps.hdc, rc.iRight, rc.iBottom)                        ' Буфферная картинка
            obmp = SelectObject(tdc, tbmp)
            GdipCreateFromHDC tdc, gr                                                          ' Создаем Graphics
            GdipGraphicsClear gr, &HFFFFFFFF                                                    ' Заливаем белым цветом
            GdipImageSelectActiveFrame img, DEFINE_GUID(FrameDimensionTime), index              ' Выбираем текущий кадр
            GdipDrawImage gr, img, 0, 0                                                        ' Рисуем его
            GdipDeleteGraphics gr                                                              ' Удаляем Graphics
            BitBlt ps.hdc, 0, 0, rc.iRight - rc.iLeft, _
                  rc.iBottom - rc.iTop, tdc, 0, 0, vbSrcCopy                                  ' Отрисовка из буфера
            SelectObject tdc, obmp                                                              ' Восстанавливаем и удаляем ....
            DeleteObject tbmp
            DeleteDC tdc
            EndPaint hwnd, ps
        End If
    Case Else
        WndProc = CallWindowProc(prevwndproc, hwnd, Msg, wParam, lParam)                        ' Остальное нас не интересует
    End Select
End Function
' Процедура таймера
Private Sub TimerProc(ByVal hwnd As Long, ByVal Msg As Long, idEvent As Long, ByVal dwTime As Long)
    index = index + 1                                                                          ' Кадр увеличился
    If index >= frames Then                                                                    ' Если переаолнение кадров
        index = 0                                                                              ' В начало
        cycle = cycle + 1                                                                      ' Увеличиваем циклы
        If cycle > loops And CBool(loops) Then StopAnim: Exit Sub                              ' Если переполнение циклов то выключаем анимацию
    End If
    RedrawWindow mHwnd, ByVal 0, 0, RDW_INVALIDATE                                              ' Перерисовываем
    If SetTimer(mHwnd, 1, frame(index) * 10, AddressOf TimerProc) = 0 Then                      ' Устанавливаем новую задержку
        StopAnim                                                                                ' Не удалось запустить таймер
    End If
End Sub

---

P.S. When debugging, it is desirable to stop the project form is closed, rather than using the Stop button, otherwise it may "crash" IDE.
Good luck!

Attachment 123743

Does not play this gif, just renders the complete image.

Attachment 194536

I modified your code to derive the frame count from the size of the PropertyTagFrameDelay buffer ((size - 16)/4), since GdipImageGetFrameCount(img, DEFINE_GUID(FrameDimensionTime), frames) returns frames=1, and modified the timer proc to impose a small delay if the delay is 0 (If frame(index) = 0 Then frame(index) = 10 ). But still no luck.

Web browsers, wqweto's program that decodes everything manually, and newer Windows RT stuff from VanGoghGaming are all able to correctly draw it; but I'm wondering if there's a way to make it work with GDIP as those methods are far more complex (and the latter doesn't work on anything before Windows 10 20H1).

Thank you for testing!

Good posting of Trick's. It draws my attention because it uses very little code, clean and unambiguous. Pity it doesn't honour the transparency when the GIF files have a designated transparent color.

The 217 x 217 animated GIF file shown by fafalone is rather peculiar, Apart from the zero time delay of frames, some of the individual local palettes appear not bearing relevance to the actual color used by the respective frame images. Take Frame 171, 172 and 173 (last frame) for example; each image of these frames uses only one color, yet they all have 256 local palette entries of assorted colors.

Given the said zero time delay of frames, it is understandable that GDIplus reports a frame count of 1 only, because there isn't enough delay time needed to let it build up the buffer ready for frames retrieval.

What is really interesting is that, under normal circumstances the image available is the 1st frame. However, Trick's code obtains the image of the 173th frame (the last). The original, unprocessed last frame is sized 41 x 9 pixels, starting at offset [176, 208]. To arrive at the last PROCESSED frame, it must have processed the frames before it. Otherwise how can Trick's code obtain the image of the PROCESSED last frame.

The above-said really puzzles to me. I myself don't use GDIplus for the animated GIF and PNG. Like wqweto's GIF.cls for the animated GIF, I use my own PNG.cls for the animated PNG (but I need zLib.dll for compression and decompression, and for CRC checksum).

WIC renders it right. In between this and wqweto's work in complexity. Just need to work out a few kinks in resizing and will have that version up in the next few days.

> Given the said zero time delay of frames, it is understandable that GDIplus reports a frame count of 1 only, because there isn't enough delay time needed to let it build up the buffer ready for frames retrieval.

The specification is unclear on zero delay time.

Code:

---

            vii) Delay Time - If not 0, this field specifies the number of
            hundredths (1/100) of a second to wait before continuing with the
            processing of the Data Stream. The clock starts ticking immediately
            after the graphic is rendered. This field may be used in
            conjunction with the User Input Flag field.

---

The WIC Animated GIF sample coalesces frames with zero delay time (i.e. m_uFrameDelay == 0) together:

Code:

---

        // Keep composing frames until we see a frame with delay greater than
        // 0 (0 delay frames are the invisible intermediate frames), or until
        // we have reached the very last frame.
        while (SUCCEEDED(hr) && m_uFrameDelay == 0 && !IsLastFrame())
        {
            hr = DisposeCurrentFrame();
            if (SUCCEEDED(hr))
            {
                hr = OverlayNextFrame();
            }

---

*but* they have special code for zero delay time for compat purposes explained in this snippet:

Code:

---

            // Insert an artificial delay to ensure rendering for gif with very small
            // or 0 delay.  This delay number is picked to match with most browsers'
            // gif display speed.
            //
            // This will defeat the purpose of using zero delay intermediate frames in
            // order to preserve compatibility. If this is removed, the zero delay
            // intermediate frames will not be visible.
            if (m_uFrameDelay < 90)
            {
                m_uFrameDelay = 90;
            }

---

cheers,
</wqw>

@wqweto: By combining (i) the pieces of info you provided; (ii) the fact that I did see some tiny blinks while the processed frame was being formed, and (iii) my imagination, I guess I should accept that it is possible to arrive at the processed final frame, despite only 1 frame count was reported.

While we're here, would you please take a look at the ZIP below, for an image that I had used and the msgbox I got.

Remarks: I've just been told that I can't upload the above said ZIP because of the space constraint. I've now uploaded it a free download site instead: https://limewire.com/d/f1dsB#WMZ7Ct3Lua

The decompressor assumed each chunk starts with CLEAR_TABLE code but obviously there are encoders which do not emit this as starting symbol.

Fixed in commit af2af32

cheers,
</wqw>

Quote:

---

Originally Posted by wqweto

> Given the said zero time delay of frames, it is understandable that GDIplus reports a frame count of 1 only, because there isn't enough delay time needed to let it build up the buffer ready for frames retrieval.

The specification is unclear on zero delay time.

Code:

---

            vii) Delay Time - If not 0, this field specifies the number of
            hundredths (1/100) of a second to wait before continuing with the
            processing of the Data Stream. The clock starts ticking immediately
            after the graphic is rendered. This field may be used in
            conjunction with the User Input Flag field.

---

The WIC Animated GIF sample coalesces frames with zero delay time (i.e. m_uFrameDelay == 0) together:

Code:

---

        // Keep composing frames until we see a frame with delay greater than
        // 0 (0 delay frames are the invisible intermediate frames), or until
        // we have reached the very last frame.
        while (SUCCEEDED(hr) && m_uFrameDelay == 0 && !IsLastFrame())
        {
            hr = DisposeCurrentFrame();
            if (SUCCEEDED(hr))
            {
                hr = OverlayNextFrame();
            }

---

*but* they have special code for zero delay time for compat purposes explained in this snippet:

Code:

---

            // Insert an artificial delay to ensure rendering for gif with very small
            // or 0 delay.  This delay number is picked to match with most browsers'
            // gif display speed.
            //
            // This will defeat the purpose of using zero delay intermediate frames in
            // order to preserve compatibility. If this is removed, the zero delay
            // intermediate frames will not be visible.
            if (m_uFrameDelay < 90)
            {
                m_uFrameDelay = 90;
            }

---

cheers,
</wqw>

---

By most browsers I guarantee they're still talking about 1990s Netscape like with IShellImageData. The 90ms minimum is not something used by modern browsers. Many gifs play noticeably slow compared to browsers if you don't change that. I only impose an artificial delay if it's *actually* 0 (but the metadata lookup didn't error), and that works for everything so far. I put a note saying we'll just have to risk some 90s Era gifs with bad time entries being a little fast.

I've also fixed the background color function to 0 the alpha value per https://github.com/microsoft/Windows...les/issues/381

Haven't gotten back to it yet to fix the sizing issues and add some other UC options for it, but I also added load from memory and load from resource. Going to make it great to make up for the simple one's many oversights.

Yes, the fix quite heavy-handed IMO and I would personally fix only equal to zero case too.

cheers,
</wqw>