GDIPlus ASCII GIF Anim Player [Windows only]

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
UEZ
Posts: 336
Joined: May 05, 2017 19:59
Location: Germany

GDIPlus ASCII GIF Anim Player [Windows only]

Postby UEZ » Feb 13, 2019 23:10

Downloads an animated GIF to memory, converts real time each frame to ASCII and displays it in the GUI.

Image

GDIPlus ASCII GIF Anim Player.bas

Code: Select all

'Coded by UEZ build 2019-02-15

#Include "file.bi"
#Include "fbgfx.bi"
#Include "windows.bi"
#Include "win\wininet.bi"

#Ifdef __Fb_64bit__
    #Inclib "gdiplus"
    #Include "win/gdiplus-c.bi"
#Else
    #Include "win/gdiplus.bi"
    Using gdiplus
#Endif

Using FB

Function _GDIPlus_BitmapCreateFromMemory3(aBinImage As Ubyte Ptr, iLen As Ulong, bBitmap_GDI As Bool = False) As Any Ptr
   Dim As HGLOBAL hGlobal
   Dim As LPSTREAM hStream
   Dim As Any Ptr hImage_Stream
   Dim As Any Ptr hMemory = GlobalAlloc(GMEM_MOVEABLE, iLen)
   Dim As Any Ptr lpMemory = GlobalLock(hMemory)
   RtlCopyMemory(lpMemory, @aBinImage[0], iLen)
   GlobalUnlock(hMemory)
   CreateStreamOnHGlobal(hMemory, 0, @hStream)
   GdipCreateBitmapFromStream(hStream, @hImage_Stream)
   IUnknown_Release(hStream)

   If bBitmap_GDI = TRUE Then
      Dim hImage_GDI As Any Ptr
      GdipCreateHBITMAPFromBitmap(hImage_Stream, @hImage_GDI, &hFF000000)
      GdipDisposeImage(hImage_Stream)
      Return hImage_GDI
   Endif

   Return hImage_Stream
End Function

Function LoadDataFromINet(sUrl As String, Byref iSize As Ulong) As Byte Ptr
   Dim As HINTERNET hOpen = InternetOpen("FB Downloader", INTERNET_OPEN_TYPE_DIRECT, NULL, NULL, INTERNET_FLAG_NO_COOKIES Or INTERNET_FLAG_NO_UI Or INTERNET_FLAG_PRAGMA_NOCACHE Or INTERNET_FLAG_SECURE), _
               hFile = InternetOpenUrl(hOpen, sURL, NULL, 0, INTERNET_FLAG_EXISTING_CONNECT, 0)
                 
   Dim As Ulong iBuffLen = 32, iBytes = 1
   Dim As String sBuff = Space(32)
   HttpQueryInfo(hFile, HTTP_QUERY_CONTENT_LENGTH, StrPtr(sBuff), @iBuffLen, NULL)
   iBuffLen = Valint(Trim(sBuff))
   Dim As Byte Ptr imgBuffer
   If iBuffLen > 0 Then
      imgBuffer = Allocate(iBuffLen)
      Do Until iBytes = 0
         InternetReadFile(hFile, imgBuffer, iBuffLen, @iBytes)
      Loop
   Endif
   InternetCloseHandle(hFile)
   InternetCloseHandle(hOpen)
   iSize = iBuffLen
   Return imgBuffer
End Function

Function _GDIPlus_ImageSaveToFile(hImage As Any Ptr, Filename As Wstring, JPGQual As Ulong = 85) As Boolean
   'check If hImage Is a GDI+ image
   Dim As Single iW, iH
   If  GdipGetImageDimension(hImage, @iW, @iH) <> 0 Then Return 0
   
   Dim As Byte iErr = 0

   Dim As Ulong count, size
   GdipGetImageEncodersSize(@count, @size)
   
   Dim As CLSID clsid
   Dim As ImageCodecInfo Ptr pImageCodecInfo
   pImageCodecInfo = Allocate(size)
   GdipGetImageEncoders(count, size, pImageCodecInfo)

   #Define _MimeType(x)   (*Cast(Wstring Ptr, pImageCodecInfo[x].MimeType))
   #Define FnSuffix   (Right(Filename, 4))   
   
   For i As Ulong = 0 To count - 1
      If _MimeType(i) = "image/bmp" And FnSuffix = ".bmp" Then
         If (GdipSaveImageToFile(hImage, Wstr(Filename), @pImageCodecInfo[i].Clsid, NULL) <> 0) Then iErr += 1
      Elseif _MimeType(i) = "image/jpeg" And (FnSuffix = ".jpg" Or FnSuffix = ".jpe" Or Right(Filename, 5) = ".jpeg" Or Right(Filename, 5) = ".jfif") Then
         JPGQual = Iif(JPGQual < 0, 0, Iif(JPGQual > 100, 100, JPGQual))
         Dim tParams As EncoderParameters
         Dim EncoderQuality As String = "{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"
         tParams.Count = 1
         CLSIDFromString(Wstr(EncoderQuality), @tParams.Parameter(0).GUID)
         With tParams.Parameter(0)
            .NumberOfValues = 1
            .Type = EncoderParameterValueTypeLong
            .Value = Varptr(JPGQual)
         End With
         If GdipSaveImageToFile(hImage, Wstr(Filename), @pImageCodecInfo[i].Clsid, @tParams) <> 0 Then iErr += 1         
      Elseif _MimeType(i) = "image/gif" And FnSuffix = ".gif" Then
         If (GdipSaveImageToFile(hImage, Wstr(Filename), @pImageCodecInfo[i].Clsid, NULL) <> 0) Then iErr += 1
      Elseif _MimeType(i) = "image/tiff" And (FnSuffix = ".tif" Or Right(Filename, 5) = ".tiff") Then
         If (GdipSaveImageToFile(hImage, Wstr(Filename), @pImageCodecInfo[i].Clsid, NULL) <> 0) Then iErr += 1
      Elseif _MimeType(i) = "image/png" And FnSuffix = ".png" Then
         If (GdipSaveImageToFile(hImage, Wstr(Filename), @pImageCodecInfo[i].Clsid, NULL) <> 0) Then iErr += 1     
      Else
         iErr += 1
      End If
   Next

   Deallocate(pImageCodecInfo)

   If iErr > 0 Then Return False

   Return True
End Function

Function _GDIPlus_BitmapScale(hImage As Any Ptr, fScaleX As Single, fScaleY As Single, iInterpolationMode As Ubyte = InterpolationModeHighQualityBicubic) As Any Ptr
   Dim As Single iW, iH, fW, fH
   GdipGetImageDimension(hImage, @iW, @iH)
   If iW = 0 Or iH = 0 Then Return 0
   fW = iW * fScaleX
   fH = iH * fScaleY
   Dim As Any Ptr hBitmap_Scaled, hGfx_Scaled
   GdipCreateBitmapFromScan0(fW, fH, 0, PixelFormat32bppARGB, 0, @hBitmap_Scaled)
   GdipGetImageGraphicsContext(hBitmap_Scaled, @hGfx_Scaled)
   'GdipSetCompositingQuality(hGfx_Scaled, 2)
   GdipSetPixelOffsetMode(hGfx_Scaled, PixelOffsetModeHighQuality)
   GdipSetInterpolationMode(hGfx_Scaled, iInterpolationMode)
   GdipDrawImageRectRect(hGfx_Scaled, hImage, 0, 0, fW, fH, 0, 0, iW, iH, 2, 0, 0, 0)
   GdipDeleteGraphics(hGfx_Scaled)
   Return hBitmap_Scaled
End Function

Function _GDIPlus_BitmapResize(hImage As Any Ptr, iNewW As Ushort, iNewH As Ushort, iInterpolationMode As Ubyte = InterpolationModeHighQualityBicubic) As Any Ptr
   Dim As Single iW, iH
   GdipGetImageDimension(hImage, @iW, @iH)
   If iW = 0 Or iH = 0 Then Return 0
   Dim As Any Ptr hBitmap_Resized, hGfx_Resized
   GdipCreateBitmapFromScan0(iNewW, iNewH, 0, PixelFormat32bppARGB, 0, @hBitmap_Resized)
   GdipGetImageGraphicsContext(hBitmap_Resized, @hGfx_Resized)
   'GdipSetCompositingQuality(hGfx_Resized, 2)
   GdipSetPixelOffsetMode(hGfx_Resized, PixelOffsetModeHighQuality)
   GdipSetInterpolationMode(hGfx_Resized, iInterpolationMode)
   GdipDrawImageRectRect(hGfx_Resized, hImage, 0, 0, iNewW, iNewH, 0, 0, iW, iH, 2, 0, 0, 0)
   GdipDeleteGraphics(hGfx_Resized)
   Return hBitmap_Resized
End Function

Function _GDIPlus_BitmapCreateGreyscale(hImage As Any Ptr) As Any Ptr
   Dim As Single iW, iH
   GdipGetImageDimension(hImage, @iW, @iH)
   If iW = 0 Or iH = 0 Then Return 0
   
   Dim As Any Ptr hBitmap_Greyscale
   Dim As BitmapData tBitmapData, tBitmapData_Greyscale
   Dim As Long iX, iY, iRowOffset, iColor, c, iR, iG, iB
   
   Dim As Rect tRect = Type(0, 0, iW - 1, iH - 1)
   
   GdipCreateBitmapFromScan0(iW, iH, 0, PixelFormat32bppARGB, 0, @hBitmap_Greyscale)
   GdipBitmapLockBits(hBitmap_Greyscale, Cast(Any Ptr, @tRect), ImageLockModeWrite, PixelFormat32bppARGB, @tBitmapData_Greyscale)
   GdipBitmapLockBits(hImage, Cast(Any Ptr, @tRect), ImageLockModeRead, PixelFormat32bppARGB, @tBitmapData)
   
   For iY = 0 To iH - 1
      iRowOffset = iY * iW
      For iX = 0 To iW - 1
         iColor = Cast(ULong Ptr, tBitmapData.Scan0)[iRowOffset + iX]
         iR = (iColor Shr 16) And &hFF
         iG = (iColor Shr 8) And &hFF
         iB = iColor And &hFF
         c = Culng((iR * 213 + iG * 715 + iB * 72) / 1000)
         Cast(ULong Ptr, tBitmapData_Greyscale.Scan0)[iRowOffset + iX] = &hFF000000 + (c Shl 16) + (c Shl 8) + c
      Next
   Next
   
   GdipBitmapUnlockBits(hBitmap_Greyscale, @tBitmapData_Greyscale)
   GdipBitmapUnlockBits(hImage, @tBitmapData)
   Return hBitmap_Greyscale   
End Function

Function _GDIPlus_BitmapCreateBW(hImage As Any Ptr, iThreshold As Ubyte = &h80) As Any Ptr
   Dim As Single iW, iH
   Dim As Any Ptr hBitmap_BW
   Dim As BitmapData tBitmapData, tBitmapData_BW
   Dim As Long iX, iY, iRowOffset, iColor, iR, iG, iB
      
   GdipGetImageDimension(hImage, @iW, @iH)
   
   Dim As Rect tRect = Type(0, 0, iW - 1, iH - 1)
   
   GdipCreateBitmapFromScan0(iW, iH, 0, PixelFormat32bppARGB, 0, @hBitmap_BW)
   GdipBitmapLockBits(hBitmap_BW, Cast(Any Ptr, @tRect), ImageLockModeWrite, PixelFormat32bppARGB, @tBitmapData_BW)
   GdipBitmapLockBits(hImage, Cast(Any Ptr, @tRect), ImageLockModeRead, PixelFormat32bppARGB, @tBitmapData)
   
   For iY = 0 To iH - 1
      iRowOffset = iY * iW
      For iX = 0 To iW - 1
         iColor = Cast(ULong Ptr, tBitmapData.Scan0)[iRowOffset + iX]
         iR = (iColor Shr 16) And &hFF
         iG = (iColor Shr 8) And &hFF
         iB = iColor And &hFF
         If Clng((iR + iG + iB) / 3) >= iThreshold Then
            Cast(ULong Ptr, tBitmapData_BW.Scan0)[iRowOffset + iX] = &hFFFFFFFF
         Else
            Cast(ULong Ptr, tBitmapData_BW.Scan0)[iRowOffset + iX] = &hFF000000
         End If
      Next
   Next
   
   GdipBitmapUnlockBits(hBitmap_BW, @tBitmapData_BW)
   GdipBitmapUnlockBits(hImage, @tBitmapData)
   Return hBitmap_BW   
End Function

Function _GDIPlus_BitmapConvert2ASCII(hImage As Any Ptr, iCharSize As Single = 8.0, iColorMode As Ubyte = 0, bInverted As Bool = False) As Any Ptr
   Dim As Single iW, iH
   GdipGetImageDimension(hImage, @iW, @iH)
   If iW = 0 Or iH = 0 Then Return 0
   Dim As Any Ptr hBitmap_ASCII, hBitmap_Scaled, hBitmap_Resized, hBitmap_Grey, hGFX_ASCII, hBrush_ASCII, hFamily, hFont, hStringFormat
   hBitmap_Scaled = _GDIPlus_BitmapScale(hImage, 1 / iCharSize, 1 / iCharSize)
   hBitmap_Resized = _GDIPlus_BitmapResize(hBitmap_Scaled, iW, iH, InterpolationModeNearestNeighbor)
   hBitmap_Grey = _GDIPlus_BitmapCreateGreyscale(hBitmap_Resized)
      
   GdipCreateBitmapFromScan0(iW, iH, 0, PixelFormat32bppARGB, 0, @hBitmap_ASCII)
   GdipGetImageGraphicsContext(hBitmap_ASCII, @hGFX_ASCII)
   GdipGraphicsClear(hGFX_ASCII, Iif(bInverted, &hFF000000, &hFFFFFFFF))
   GdipSetSmoothingMode(hGFX_ASCII, SmoothingModeAntiAlias)
   GdipSetPixelOffsetMode(hGFX_ASCII, PixelOffsetModeHalf)
   GdipSetTextRenderingHint(hGFX_ASCII, TextRenderingHintAntiAlias)
   GdipCreateStringFormat(0, 0, @hStringFormat)
   GdipCreateFontFamilyFromName("Lucida Console", Null, @hFamily)
   GdipCreateFont(hFamily, iCharSize, 1, 3, @hFont)
   GdipCreateSolidFill(Iif(bInverted, &hFFFFFFFF, &hFF000000), @hBrush_ASCII)
   
   #Define Map(n, s, e, ns, ne) (ns - (ns - ne) * (n / (e - s)))
   
   Dim As Rect tRect = Type(0, 0, iW - 1, iH - 1)
   Dim As BitmapData tBitmapData_Grey, tBitmapData_Resized
   GdipBitmapLockBits(hBitmap_Grey, Cast(Any Ptr, @tRect), ImageLockModeRead, PixelFormat32bppARGB, @tBitmapData_Grey)
   GdipBitmapLockBits(hBitmap_Resized, Cast(Any Ptr, @tRect), ImageLockModeRead, PixelFormat32bppARGB, @tBitmapData_Resized)
   Dim As ULong iX, iY, iRowOffset, col, x, y
   Dim as GpRectF tLayout
   Dim As String aChars(0 To ...) = {"#", "@", "%", "X", "x", "o", "+", "=", "~", "-", ";", ":", ",", "." , " "}
   tLayout.width = iCharSize * 1.666
   tLayout.height = iCharSize * 1.666
   iColorMode = Iif(iColorMode > 2, 2, iColorMode)
   
   For iY = 0 To (iH - iCharSize) Step iCharSize
      For iX = 0 To (iW - iCharSize) Step iCharSize
         x = iX + iCharSize \ 2
         y = (iY + iCharSize \ 2) * iW
         col = Cast(ULong Ptr, tBitmapData_Grey.Scan0)[y + x] And &hFF
         tLayout.x = iX
         tLayout.y = iY
         Select Case iColorMode
            Case 0 'b/w
               'brush already defined above
            Case 1 'color
               GdipSetSolidFillColor(hBrush_ASCII, Iif(bInverted, &hFFFFFF Xor Cast(ULong Ptr, tBitmapData_Resized.Scan0)[y + x], Cast(ULong Ptr, tBitmapData_Resized.Scan0)[y + x]))
            Case 2 'greyscale
               col = Iif(bInverted, col Xor &hFF, col)
               GdipSetSolidFillColor(hBrush_ASCII, &hFF000000 Or col Shl 16 Or col Shl 8 Or col)
         End Select
         GdipDrawString(hGFX_ASCII, aChars(Map(col, 0, 255, 0, Ubound(aChars))), -1, hFont, @tLayout, hStringFormat, hBrush_ASCII)
      Next
   Next
   GdipBitmapUnlockBits(hBitmap_ASCII, @tBitmapData_Grey)
   GdipBitmapUnlockBits(hBitmap_ASCII, @tBitmapData_Resized)
   GdipDisposeImage(hBitmap_Scaled)
   GdipDisposeImage(hBitmap_Resized)
   GdipDisposeImage(hBitmap_Grey)
   GdipDeleteFont(hFont)
   GdipDeleteFontFamily(hFamily)
   GdipDeleteStringFormat(hStringFormat)
   GdipDeleteBrush(hBrush_ASCII)
   GdipDeleteGraphics(hGFX_ASCII)
   Return hBitmap_ASCII
End Function


'decode animated GIF and select frame
Function _GDIPlus_GIFAnimGetFrameDimensionsCount(hImage As Any Ptr) As Ulong
   Dim As Ulong iFrameDimCount
   GdipImageGetFrameDimensionsCount(hImage, @iFrameDimCount)
   Return iFrameDimCount
End Function

Function _GDIPlus_GIFAnimGetFrameDimensionsList(hImage As Any Ptr, iFrameDimCount As Ulong) As GUID
   Dim As GUID FrameDimList
   GdipImageGetFrameDimensionsList(hImage, @FrameDimList, iFrameDimCount)
   Return FrameDimList
End Function

Function _GDIPlus_GIFAnimGetFrameCount(hImage As Any Ptr, tFrameDimList As GUID) As Ulong
   Dim As Ulong iFrameCount
   GdipImageGetFrameCount(hImage, @tFrameDimList, @iFrameCount)
   Return iFrameCount
End Function

Sub _GDIPlus_GIFAnimSelectActiveFrame(hImage As Any Ptr, tFrameDimList As GUID, iCurrentFrame As Ulong)
   GdipImageSelectActiveFrame(hImage, @tFrameDimList, iCurrentFrame)
End Sub

Function _GDIPlus_ImageGetPropertyItem(hImage As Any Ptr, iPropID As PROPID) As PropertyItem Ptr
   Dim As Ulong iSize
   GdipGetPropertyItemSize(hImage, iPropID, @iSize)
   Dim As PropertyItem Ptr buffer
   buffer = Allocate(iSize * SizeOf(PropertyItem))
   GdipGetPropertyItem(hImage, iPropID, iSize, @buffer[0])
   Return buffer
End Function

Sub _GDIPlus_GIFAnimGetFrameDelays(hImage As Any Ptr, iAnimFrameCount As Ulong, aFrameDelay() As Ulong)
   Dim As PropertyItem Ptr PropItem = _GDIPlus_ImageGetPropertyItem(hImage, PROPERTYTAGFRAMEDELAY)
   Select Case PropItem->type
      Case 1
         Dim As Ubyte Ptr delay = PropItem->value
         For i As Ulong = 0 To Ubound(aFrameDelay)
            aFrameDelay(i) = delay[i] * 10
         Next
      Case 3
         Dim As Ushort Ptr delay = PropItem->value
         For i As Ulong = 0 To Ubound(aFrameDelay)
            aFrameDelay(i) = delay[i] * 10
         Next
      Case 4
         Dim As Ulong Ptr delay = PropItem->value
         For i As Ulong = 0 To Ubound(aFrameDelay)
            aFrameDelay(i) = delay[i] * 10
         Next
   End Select
End Sub


Dim Shared gdipToken As ULONG_PTR
Dim Shared GDIp As GdiplusStartupInput
GDIp.GdiplusVersion = 1
If GdiplusStartup(@gdipToken, @GDIp, NULL) <> 0 Then End


Dim As Single iW, iH
Dim As Any Ptr hCanvas, hImage, hImage_ASCII
Dim As String sURL = "https://i.gifer.com/17YK.gif", sFilename = Curdir & "\17YK.gif" 'https://gifer.com/en/
If Fileexists(sFilename) = -1 Then
   'local loa
   GdipLoadImageFromFile(sFilename, @hImage)
Else
   If Messagebox(0, "Do you agree to download an image from internet?", "Information", MB_ICONQUESTION or MB_YESNO) = 7 Then
      Messagebox(0, "This demo requires an image. Please enable code line to load from local disk and disable code for download! Do not forget to adjust the path to the image!", "Information", MB_ICONWARNING)
      GdiplusShutdown(gdipToken)
      End
   End If
   'internet load
   Dim As Ulong iSize
   Dim As Byte Ptr binImg = LoadDataFromINet(sURL, iSize)
   Dim As Integer hFile = FreeFile()
   Open sFilename For Binary Access Write As #hFile
   Put #hFile, 0, binImg[0], iSize
   Close #hFile
   hImage = _GDIPlus_BitmapCreateFromMemory3(binImg, iSize)
   Deallocate binImg
Endif
GdipGetImageDimension(hImage, @iW, @iH)

If iW = 0 Then
   GdiplusShutdown(gdipToken)
   Messagebox(0, "Something went wrong to download the GIF animation!", "ERROR", 16)
   End
End If

Screencontrol SET_DRIVER_NAME, "GDI"
Screenres iW, iH, 32, 1, GFX_HIGH_PRIORITY Or GFX_NO_SWITCH
Windowtitle "GDIPlus ASCII GIF Anim Player by UEZ"

Dim As Integer iDW, iDH
Screencontrol GET_DESKTOP_SIZE, iDW, iDH
Dim tWorkingArea As RECT
SystemParametersInfo(SPI_GETWORKAREA, null, @tWorkingArea, null)
Screencontrol SET_WINDOW_POS, (iDW - iW) \ 2, ((tWorkingArea.Bottom - iH) - (iDH - tWorkingArea.Bottom)) \ 2

Dim As HWND hHWND
Screencontrol(GET_WINDOW_HANDLE, Cast(Integer, hHWND))

Dim As Any Ptr    hDC = GetDC(hHWND), _
            hHBitmap = CreateCompatibleBitmap(hDC, iW, iH), _
            hDC_backbuffer = CreateCompatibleDC(hDC), _
            hDC_obj = SelectObject(hDC_backbuffer, hHBitmap)
GdipCreateFromHDC(hDC_backbuffer, @hCanvas)            

Dim As Ulong iFrame = 0, iFrameDimCount = _GDIPlus_GIFAnimGetFrameDimensionsCount(hImage)
Dim As GUID tFrameDimList = _GDIPlus_GIFAnimGetFrameDimensionsList(hImage, iFrameDimCount)
Dim As Ulong iFrames = _GDIPlus_GIFAnimGetFrameCount(hImage, tFrameDimList)
Dim As Ulong aFrameDelays(0 To iFrames - 1)
Dim As Any Ptr aFrames(0 To iFrames - 1)
Dim As Bool bInverted = False
Dim As Byte bLMB = 1

? "Please wait while frames will be buffered!"
'render all frames to save CPU usage later in the loop
For i As Ulong = 0 To Ubound(aFrames)
   _GDIPlus_GIFAnimSelectActiveFrame(hImage, tFrameDimList, i)
   aFrames(i) = _GDIPlus_BitmapConvert2ASCII(hImage, 8, 1, bInverted)   
Next
_GDIPlus_GIFAnimGetFrameDelays(hImage, iFrames, aFrameDelays())

Dim evt As Event

Do 
   _GDIPlus_GIFAnimSelectActiveFrame(hImage, tFrameDimList, iFrame)
   If bLMB = 1 Then
      GdipDrawImageRect(hCanvas, aFrames(iFrame), 0, 0, iW, iH)
   Else
      GdipGraphicsClear(hCanvas, Iif(bInverted, &hFF000000, &hFFFFFFFF)) 'visible only for transparent animated GIFs
      GdipDrawImageRect(hCanvas, hImage, 0, 0, iW, iH)
   End If
   BitBlt(hDC, 0, 0, iW, iH, hDC_backbuffer, 0, 0, SRCCOPY)
   
   Sleep aFrameDelays(iFrame)
   Windowtitle "Frame: " & iFrame + 1 & " / " & iFrames
   
   iFrame += 1
   iFrame = Iif(iFrame > iFrames - 1, 0, iFrame)
   
   If (Screenevent(@evt)) Then
      Select Case evt.Type
         Case EVENT_KEY_PRESS
            If evt.scancode = SC_ESCAPE Then Exit Do
         Case EVENT_WINDOW_CLOSE
            Exit Do
         Case EVENT_MOUSE_BUTTON_PRESS
            If evt.button = BUTTON_LEFT Then bLMB *= -1
      End Select
   Endif
Loop

For i As Ulong = 0 To Ubound(aFrames)
   GdipDisposeImage(aFrames(i))
Next
SelectObject(hDC_backbuffer, hDC_obj)
DeleteDC(hDC_backbuffer)
DeleteObject(hHBitmap)
ReleaseDC(hHWND, hDC)
GdipDeleteGraphics(hCanvas)
GdipDisposeImage(hImage)
GdipDisposeImage(hImage_ASCII)
GdiplusShutdown(gdipToken)


Press 1x lmb to switch ASCII / image view.


To do: get each frame delay. done. But I don't know how accurate this is for different GIF animated files. ^^
Last edited by UEZ on Feb 15, 2019 12:31, edited 4 times in total.
jj2007
Posts: 1242
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: GDIPlus ASCII GIF Anim Player [Windows only]

Postby jj2007 » Feb 14, 2019 2:33

Works like a charm, compliments!
I also gave it a try (Animated GIF). but it seems I have to check what my FileRead$() does, it takes over 10 seconds to download the image. You are using the INTERNET_FLAG_PRAGMA_NOCACHE flag, and yet it is there almost immediately. Mysteries...
maachal
Posts: 32
Joined: Jul 21, 2017 21:11
Location: czech

Re: GDIPlus ASCII GIF Anim Player [Windows only]

Postby maachal » Feb 14, 2019 8:28

Beware, this server (request https://i.gifer.com/6H3K.gif) does not return a clean GIF, but a full page with a video. :-(
counting_pine
Site Admin
Posts: 6173
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs

Re: GDIPlus ASCII GIF Anim Player [Windows only]

Postby counting_pine » Feb 14, 2019 11:45

As always, a nice example. But it would be better if the example image here could be a bit more "safe for work".
UEZ
Posts: 336
Joined: May 05, 2017 19:59
Location: Germany

Re: GDIPlus ASCII GIF Anim Player [Windows only]

Postby UEZ » Feb 14, 2019 13:20

Thanks for your feedback.

I updated the code. Now each frame delay will be saved to an array and used for sleep. Furthermore, all frames will be precalculated and saved to an array to save CPU usage. It might take some time if the GIF is large.

Regarding choosing the right GIF animation for demo purposes: believe me that I've spend a lot of time to find something proper to use here. The previous one was somehow funny. Anyhow, I changed it.

If you have a cool one which fits here, please provide the link. :-)
Last edited by UEZ on Feb 15, 2019 12:32, edited 1 time in total.
counting_pine
Site Admin
Posts: 6173
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs

Re: GDIPlus ASCII GIF Anim Player [Windows only]

Postby counting_pine » Feb 14, 2019 13:41

Thanks for changing it. I don't really like GIF web sites and the general randomness of their content, but something like https://i.gifer.com/17YK.gif might work well. (8-bit, chunky, with motion).
But the image you've changed to is already "very cool".
maachal
Posts: 32
Joined: Jul 21, 2017 21:11
Location: czech

Re: GDIPlus ASCII GIF Anim Player [Windows only]

Postby maachal » Feb 14, 2019 13:58

The original image also works if https://i.gifer.com/embedded/download/6H3K.gif (not: https://i.gifer.com/6H3K.gif) is used. It takes a moment to wait. A very nice example.
jj2007
Posts: 1242
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: GDIPlus ASCII GIF Anim Player [Windows only]

Postby jj2007 » Feb 14, 2019 14:14

Try this one, it's better for work: https://media.giphy.com/media/NAVQDibk6Sesg/giphy.gif
leopardpm
Posts: 1792
Joined: Feb 28, 2009 20:58

Re: GDIPlus ASCII GIF Anim Player [Windows only]

Postby leopardpm » Feb 16, 2019 3:36

Pretty Sweet! There is so much I could learn from this - very nice! Thank you for the Tips

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 36 guests