Differential Image Generator

' This is the Differential Image Generator.
' The purpose of the subroutine is to remove common pixels between the base image
' and any successively numbered images that follow it.
'
' System was designed around the fact that when I make animation frames with Blender
' I generate them in a sequencial manner, eg: name-1001, name-1002, etc.
'
' The end result is a generation of smaller memory model images that GIF animation
' can take advantage of because there's more "white space" for the RLL encoding to compress.
'
' For example, taking the following base image:
' http://i19.photobucket.com/albums/b184/ddancer/renders/blink-000.gif 10,346 bytes
' and the following frame:
' http://i19.photobucket.com/albums/b184/ddancer/renders/blink-001.gif 11,899 bytes
' When run though this subroutine, generates the following image:
' http://i19.photobucket.com/albums/b184/ddancer/renders/blink-101.gif 3,699 bytes
' for a saving of about 75% on file size.
'
' To fully appreciate the savings, consider that the following version:
' http://i19.photobucket.com/albums/b184/ddancer/renders/furre-crossing1.gif 353,472 bytes
' with 34 frames, when redone using this subroutine, helped generate:
' http://i19.photobucket.com/albums/b184/ddancer/renders/furre-crossing2.gif 178,699 bytes
' with 44 frames.
'
' Further size reduction can be done by trimming each image and using the position setting
' for each frame of the animation to move the smaller image over the base image.
'
' This subroutine, and another one that does trimming was coded for use in
' making animated images in Furcadia patch files, the Furcadia animation system
' permits one to designate one image as the background image and another one for the foregound.
'
' Because the patch files can use PNG encoding for the images, the net result is the same,
' the animation takes up less space in the file than if you was to use full size frames
' for each image.
'
' As an example, the above blink-001 as a PNG is 23,383 bytes in size, when I generate
' a differential image from it, the results is an image that's only 6,097 bytes in size.
'
' The savings is about the same, though the file is bigger, but that's because in this case,
' the images are in 32bit color instead of being an 8bit palette image.
'
' And again, more savings can be achieved by trimming the results and using the positioning
' settings for each frame to overlay the animation over the base image.
'
' The above image, as a PNG, when trimmed, results in a size of 3,955 bytes.

' Before I present the actual subroutine itself, I need to show two functions
' used by the subroutine to aid it in doing it's magic.

Function GetFileNameParts(BaseFileName As String, _
    ByRef BaseFolder As String, ByRef BaseName As String, ByRef RootIndex As String) As String
Dim FiDx As Long, SiDx As Long, fileExt As String

' function walks backwards through the passed BaseFileName and extracts 4 parts from it
' because i wanted 4 items from the function, i needed to pass three parameters BYREF
'
' function extracts the file extension, the numeric index, the base filename, and the path
' from the passed filename, it returns the extension

  ' extract the file extension from the name
  For FiDx = Len(BaseFileName) To 1 Step -1
    If (Mid$(BaseFileName, FiDx, 1) = ".") Then
      SiDx = FiDx - 1
      Exit For
    End If
    fileExt = Mid$(BaseFileName, FiDx, 1) & fileExt
  Next FiDx
  fileExt = "." & fileExt

  ' extract the numeric index from the filename
  ' note we are starting at the first character past the "."
  ' going backwarks because the above bumps it past the "."
  For FiDx = SiDx To 1 Step -1
    If (InStr(1, "1234567890", Mid$(BaseFileName, FiDx, 1), vbTextCompare) = 0) Then
      SiDx = FiDx
      Exit For
    End If
    RootIndex = Mid$(BaseFileName, FiDx, 1) & RootIndex
  Next FiDx

  ' extract the remainder of the filename till the first backslash
  ' here, we continue from the point we left off from above
  For FiDx = SiDx To 1 Step -1
    If (Mid$(BaseFileName, FiDx, 1) = "\") Then
      Exit For
    End If
    BaseName = Mid$(BaseFileName, FiDx, 1) & BaseName
  Next FiDx

  ' construct the BaseName and remove it from the passed filename to make BaseFolder
  BaseName = BaseName & RootIndex & fileExt
  BaseFolder = Replace$(BaseFileName, BaseName, "")

  ' return the extension
  GetFileNameParts = fileExt

End Function


Function GatherFileNames(BasePath As String, BaseName As String, _
    fileExt As String, RootIndex As String) As String()
Dim FSO As Object, FSI As Object, FSN As Object
Dim FileNames() As String, FiDx As Long, ThisName As String

' function is designed to return a filtered set of filenames based on a
' loose match system without going through wildcards

' only return files of fileExt type
'' only if they don't match BaseName
''' only if they are part of RootIndex group
' see below for explaination of RootIndex

  Set FSO = CreateObject("Scripting.FileSystemObject")
  Set FSI = FSO.GetFolder(BasePath)

  FiDx = 0
  ReDim FileNames(FiDx)
  For Each FSN In FSI.Files
    ThisName = FSN.Name
    If (InStr(1, ThisName, fileExt, vbTextCompare) > 0) Then
      If (InStr(1, ThisName, BaseName, vbTextCompare) = 0) Then
        If (InStr(1, ThisName, RootIndex, vbTextCompare) > 0) Then
          ReDim Preserve FileNames(FiDx)
          FileNames(FiDx) = ThisName
          FiDx = FiDx + 1
        End If
      End If
    End If
  Next

  ' cleanup on asile 6
  Set FSN = Nothing
  Set FSI = Nothing
  Set FSO = Nothing

  GatherFileNames = FileNames()
End Function

' The Subroutine
' Function calls are based on using the FreeImage DLL image handling library.
' This can be adapted to using other library's with minimal adjustments.

Sub ExtractDifferences(BaseFileName As String)
Dim baseDib As Long, compareDib As Long, targetDib As Long
Dim fileFormat As Long
Dim Results As Boolean, winBlt As Boolean
Dim BaseFolder As String, BaseName As String, fileExt As String
Dim RootIndex As String, NewIndex As String, NewName As String
Dim FileNames() As String, FiDx As Long
Dim iWidth As Long, iHeight As Long
Dim hIndex As Long, wIndex As Long, uIndex As Long
Dim sourcePixel As RGBQUAD, comparePixel As RGBQUAD, BackColor As RGBQUAD

  ' load the base image into memory
  baseDib = fn_LoadImageFile(BaseFileName, False)

  ' fetch the file format based on the image file's data
  ' this is used when saving to make the results the same type of image
  fileFormat = dll_GetFIFFromFilename(BaseFileName)

  ' get the various parts of the filename that we need for generation
  fileExt = GetFileNameParts(BaseFileName, BaseFolder, BaseName, RootIndex)

  ' recycle NewName for constructing our filename gathering filter
  NewName = Replace$(BaseName, RootIndex, "")
  NewName = Replace$(NewName, fileExt, "")

  ' RootIndex is the base image from which the differential images are generated from
  RootIndex = NewName & Left$(RootIndex, 1)

  ' NewIndex is the offset for the differential images to be generated
  NewIndex = NewName & Format$(Val(Left$(RootIndex, 1)) + 1)

  ' result examples:
  '' if BaseFileName = "fireplace-1001.png"
  '' RootIndex = "fireplace-1"
  '' NewIndex = "fireplace-2"

  ' fetch our list of names, pass BaseName to exclude it from the returned list
  FileNames = GatherFileNames(BaseFolder, BaseName, fileExt, RootIndex)


  ' we need the width, height, and one pixel from base image for background

  ' *** FREEIMAGE ACCESS'S IMAGE PIXELS UPSIDE DOWN ***
  ' means that iHeight-1 = Row Zero
  ' WE ALSO ASSUME THAT THIS IS TO BE USED FOR BACKGROUND COLOR INCLUDING TRANSPARENCY IF ANY

  iWidth = dll_GetWidth(baseDib)
  iHeight = dll_GetHeight(baseDib)
  Results = fn_GetPixelColor(baseDib, iWidth - 1, iHeight - 1, BackColor)

  For FiDx = 0 To UBound(FileNames)

    ' sanity check, make sure we got back a flock of images
    If (Len(FileNames(FiDx)) > 0) Then

      ' fetch our image to compare base with
      compareDib = fn_LoadImageFile(BaseFolder & FileNames(FiDx), False)

      ' generate a copy
      targetDib = dll_Clone(compareDib)

      ' loop through the images, mask out any matching pixels
      ' optimization: convert or code in pixel fetch to a 32bit value
      For hIndex = 0 To iWidth - 1
        For wIndex = 0 To iHeight - 1
          Results = fn_GetPixelColor(baseDib, hIndex, wIndex, sourcePixel)
          Results = fn_GetPixelColor(compareDib, hIndex, wIndex, comparePixel)
          If ((sourcePixel.rgbBlue = comparePixel.rgbBlue) _
            And (sourcePixel.rgbGreen = comparePixel.rgbGreen) _
            And (sourcePixel.rgbRed = comparePixel.rgbRed)) Then

            Results = fn_SetPixelColor(targetDib, hIndex, wIndex, BackColor)

          End If
        Next wIndex
      Next hIndex

      ' generate a new name for the results and save it
      ' this is done to prevent trashing original source images
      NewName = Replace$(FileNames(FiDx), RootIndex, NewIndex)
      Results = fn_Save(fileFormat, targetDib, BaseFolder & NewName)

      ' prevent memory leaks, always unload the darn images
      dll_Unload compareDib
      dll_Unload targetDib
    End If
  Next FiDx

  dll_Unload baseDib

End Sub