GDIPlus ASCII GIF Anim Player [Windows only]

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

GDIPlus ASCII GIF Anim Player [Windows only]

Post by UEZ »

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: 2326
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: GDIPlus ASCII GIF Anim Player [Windows only]

Post by jj2007 »

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: 33
Joined: Jul 21, 2017 21:11
Location: czech

Re: GDIPlus ASCII GIF Anim Player [Windows only]

Post by maachal »

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: 6323
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs

Re: GDIPlus ASCII GIF Anim Player [Windows only]

Post by counting_pine »

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: 972
Joined: May 05, 2017 19:59
Location: Germany

Re: GDIPlus ASCII GIF Anim Player [Windows only]

Post by UEZ »

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: 6323
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs

Re: GDIPlus ASCII GIF Anim Player [Windows only]

Post by counting_pine »

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: 33
Joined: Jul 21, 2017 21:11
Location: czech

Re: GDIPlus ASCII GIF Anim Player [Windows only]

Post by maachal »

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: 2326
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: GDIPlus ASCII GIF Anim Player [Windows only]

Post by jj2007 »

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

Re: GDIPlus ASCII GIF Anim Player [Windows only]

Post by leopardpm »

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