Results 1 to 10 of 10

Thread: [VB6] - View GIF animation.

  1. #1

    Thread Starter
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,797

    [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!

    GifViewer.zip

  2. #2
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    7,653

    Re: [VB6] - View GIF animation.

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

    Name:  8.gif
Views: 940
Size:  180.2 KB

    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).

  3. #3

  4. #4
    Hyperactive Member
    Join Date
    Sep 2014
    Posts
    392

    Re: [VB6] - View GIF animation.

    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).

  5. #5
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    7,653

    Re: [VB6] - View GIF animation.

    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.

  6. #6
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    6,167

    Re: [VB6] - View GIF animation.

    > 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>

  7. #7
    Hyperactive Member
    Join Date
    Sep 2014
    Posts
    392

    Re: [VB6] - View GIF animation.

    @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

  8. #8
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    6,167

    Re: [VB6] - View GIF animation.

    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>

  9. #9
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    7,653

    Re: [VB6] - View GIF animation.

    Quote Originally Posted by wqweto View Post
    > 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.
    Last edited by fafalone; Apr 7th, 2025 at 09:18 AM.

  10. #10

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width