VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "classGAFFrame"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
' classGAFFrame.cls
'   GAF frame class.

Option Explicit

Private Frame As GAFFrame
Private Image() As Byte

Public Subframes As New Collection

' Begin Frame Properties. '
Property Get Width() As Long
    Width = Frame.Width
End Property

Property Let Width(ByVal Value As Long)
    On Error Resume Next
    Frame.Width = Value
    ReDim Preserve Image(Frame.Width * Frame.Height - 1)
End Property

Property Get Height() As Long
    Height = Frame.Height
End Property

Property Let Height(ByVal Value As Long)
    On Error Resume Next
    Frame.Height = Value
    ReDim Preserve Image(Frame.Width * Frame.Height - 1)
End Property

Property Get PositionX() As Long
    PositionX = Frame.xPosition
End Property

Property Let PositionX(ByVal Value As Long)
    Frame.xPosition = Value
End Property

Property Get PositionY() As Long
    PositionY = Frame.yPosition
End Property

Property Let PositionY(ByVal Value As Long)
    Frame.yPosition = Value
End Property

Property Get Compressed() As Boolean
    Compressed = (Frame.Compressed > 0)
End Property

Property Let Compressed(ByVal Value As Boolean)
    If Value Then
        Frame.Compressed = 1
    Else
        Frame.Compressed = 0
    End If
End Property

Property Get FPS() As Long
    FPS = Frame.FPS
End Property

Property Let FPS(ByVal Value As Long)
    Frame.FPS = Value
End Property
' End Frame Properties. '

' Initialize the frame. '
Public Sub Initialize()
    ReDim Image(0)
    Set Subframes = New Collection
End Sub

' Load the GAF frame. '
Public Function Load(File As Integer)
    Dim Index As Long
    Dim pSubFrames() As Long
    Dim Subframe As New classGAFFrame
    Dim x As Long, y As Long, xPos As Long
    Dim Buffer() As Byte
    Dim Bytes As Integer
    Dim CH As Byte
    Dim xAt As Long
    
    ' Load the frame information. '
    On Error GoTo Error
    Load = False
    Initialize
    Get File, , Frame
    If Width = 0 Or Height = 0 Then Exit Function
    
    ' Initialize image. '
    ReDim Image(Width * Height - 1)
    For Index = 0 To UBound(Image)
        Image(Index) = GAFMaskColor
    Next
    Seek File, Frame.PTRImage + 1

    ' Load subframes. '
    If Frame.FramePointers > 0 Then
        ReDim pSubFrames(Frame.FramePointers - 1)
        Get File, , pSubFrames()
        For Index = 0 To UBound(pSubFrames)
            Seek File, pSubFrames(Index) + 1
            Set Subframe = New classGAFFrame
            If Subframe.Load(File) Then
                Subframes.Add Subframe
            End If
        Next
        Load = True
        Exit Function
    End If
    
    ' Load image. '
    If Frame.Compressed = 0 Then
        Get File, , Image()
    ElseIf Frame.Compressed = 1 Then
        For y = 0 To Height - 1
            Get File, , Bytes
            If Bytes > 0 Then
                ReDim Buffer(Bytes - 1)
                Get File, , Buffer()
                xPos = 0
                x = 0
                Do While x < Bytes
                    CH = Buffer(x)
                    x = x + 1
                    If (CH And 1) = 1 Then ' transparent '
                        xPos = xPos + Int(CH / 2)
                    Else
                        If (CH And 2) = 2 Then ' repeat pixel '
                            For xAt = 0 To Int(CH / 4)
                                Image(y * Width + xPos + xAt) = Buffer(x)
                            Next
                            x = x + 1
                            xPos = xPos + Int(CH / 4) + 1
                        Else ' pixel dump '
                            For xAt = 0 To Int(CH / 4)
                                Image(y * Width + xPos + xAt) = Buffer(x)
                                x = x + 1
                            Next
                            xPos = xPos + Int(CH / 4) + 1
                        End If
                    End If
                Loop
            End If
        Next
    End If
    Load = True
    Exit Function
Error:
End Function

' Save the GAF frame. '
Public Sub Save(File As Integer)
    Dim pSubFrames() As Long
    Dim StartOffset As Long, EndOffset As Long
    Dim Index As Long
    Dim x As Integer, y As Integer
    Dim Count As Integer
    Dim MaskCount As Integer, RepeatCount As Integer, BitCount As Integer
    Dim RepeatBit As Byte, RepeatFlag As Boolean
    Dim ThisColor As Integer, PreviousColor As Integer
    Dim Bits() As Byte
    Dim Row() As Byte, ThisRow() As Byte
    Dim i As Long, offset As Long
        
    ' Initialize. '
    Frame.Unknown1 = 9
    Frame.Unknown2 = 0
    Frame.Unknown3 = 0
    Frame.FramePointers = Subframes.Count
    Frame.PTRImage = Seek(File) + 23
    'If Frame.Compressed <> 0 Then Frame.Compressed = 0
    
    ' Save the frame. '
    Put File, , Frame
    If Subframes.Count = 0 Then
        If Frame.Compressed = 0 Then ' No compression. '
            Put File, , Image()
        Else ' Compress frame. '
            'Put File, , Image()
            For y = 0 To Height - 1
                BitCount = 0
                MaskCount = 0
                RepeatCount = 0
                Count = 0
                ReDim Row(0)
                ReDim ThisRow(0)
                PreviousColor = -1
                For x = 0 To Width - 1
                    ThisColor = Image(x + y * Width)
                    ReDim Preserve ThisRow(x)
                    ThisRow(x) = ThisColor
                    If ThisColor = GAFMaskColor Then
                        MaskCount = MaskCount + 1
                        If MaskCount = 120 Then
                            ReDim Preserve Row(Count)
                            Row(Count) = FindNearestBitKey(MaskCount * 2, 1)
                            Count = Count + 1
                            MaskCount = 0
                        End If
                        If RepeatCount > 0 Then
                            ReDim Preserve Row(Count + 1)
                            Row(Count) = FindNearestBitKey((RepeatCount - 1) * 4, 2)
                            Row(Count + 1) = RepeatBit
                            Count = Count + 2
                            RepeatCount = 0
                        ElseIf BitCount > 0 Then
                            ReDim Preserve Row(UBound(Row) + BitCount + 1)
                            Row(Count) = FindNearestBitKey((BitCount - 1) * 4, 0)
                            For i = 0 To BitCount - 1
                                Row(Count + i + 1) = Bits(i)
                            Next
                            Count = Count + BitCount + 1
                            BitCount = 0
                        End If
                        RepeatFlag = False
                    ElseIf ThisColor = PreviousColor Then
                        RepeatBit = ThisColor
                        RepeatCount = RepeatCount + 1
                        If Not RepeatFlag Then
                            BitCount = BitCount - 1
                            RepeatCount = RepeatCount + 1
                            RepeatFlag = True
                        End If
                        If RepeatCount = 55 Then
                            ReDim Preserve Row(Count + 1)
                            Row(Count) = FindNearestBitKey((RepeatCount - 1) * 4, 2)
                            Row(Count + 1) = RepeatBit
                            Count = Count + 2
                            RepeatCount = 0
                        End If
                        If MaskCount > 0 Then
                            ReDim Preserve Row(Count)
                            Row(Count) = FindNearestBitKey(MaskCount * 2, 1)
                            Count = Count + 1
                            MaskCount = 0
                        ElseIf BitCount > 0 Then
                            ReDim Preserve Row(UBound(Row) + BitCount + 1)
                            Row(Count) = FindNearestBitKey((BitCount - 1) * 4, 0)
                            For i = 0 To BitCount - 1
                                Row(Count + i + 1) = Bits(i)
                            Next
                            Count = Count + BitCount + 1
                            BitCount = 0
                        End If
                    Else
                        ReDim Preserve Bits(BitCount)
                        Bits(BitCount) = ThisColor
                        BitCount = BitCount + 1
                        If BitCount = 55 Then
                            ReDim Preserve Row(UBound(Row) + BitCount + 1)
                            Row(Count) = FindNearestBitKey((BitCount - 1) * 4, 0)
                            For i = 0 To BitCount - 1
                                Row(Count + i + 1) = Bits(i)
                            Next
                            Count = Count + BitCount + 1
                            BitCount = 0
                        End If
                        If MaskCount > 0 Then
                            ReDim Preserve Row(Count)
                            Row(Count) = FindNearestBitKey(MaskCount * 2, 1)
                            Count = Count + 1
                            MaskCount = 0
                        ElseIf RepeatCount > 0 Then
                            ReDim Preserve Row(Count + 1)
                            Row(Count) = FindNearestBitKey((RepeatCount - 1) * 4, 2)
                            Row(Count + 1) = RepeatBit
                            Count = Count + 2
                            RepeatCount = 0
                        End If
                        RepeatFlag = False
                    End If
                    PreviousColor = ThisColor
                Next
                If MaskCount > 0 Then
                    ReDim Preserve Row(Count)
                    Row(Count) = FindNearestBitKey(MaskCount * 2, 1)
                    Count = Count + 1
                    MaskCount = 0
                ElseIf RepeatCount > 0 Then
                    ReDim Preserve Row(Count + 1)
                    Row(Count) = FindNearestBitKey((RepeatCount - 1) * 4, 2)
                    Row(Count + 1) = RepeatBit
                    Count = Count + 2
                    RepeatCount = 0
                ElseIf BitCount > 0 Then
                    ReDim Preserve Row(UBound(Row) + BitCount + 1)
                    Row(Count) = FindNearestBitKey((BitCount - 1) * 4, 0)
                    For i = 0 To BitCount - 1
                        Row(Count + i + 1) = Bits(i)
                    Next
                    Count = Count + BitCount + 1
                    BitCount = 0
                End If
                Put File, , Count
                Put File, , Row()
            Next
        End If
    Else
        StartOffset = Seek(File)
        ReDim pSubFrames(Subframes.Count - 1)
        Put File, , pSubFrames()
        For Index = 0 To UBound(pSubFrames)
            pSubFrames(Index) = Seek(File) - 1
            Subframes(Index + 1).Save File
        Next
        EndOffset = Seek(File)
        Seek File, StartOffset
        Put File, , pSubFrames()
        Seek File, EndOffset
    End If
End Sub

Public Sub DecodeRow(Buffer() As Byte, Count As Integer, Row() As Byte, yrow As Integer)
    Dim x As Integer, y As Integer
    Dim xPos As Integer, xAt As Integer
    Dim CH As Byte
    Dim Image() As Byte
    Dim i As Integer
    
    On Error GoTo Error
    ReDim Image(UBound(Row))
    For i = 0 To UBound(Image)
        Image(i) = GAFMaskColor
    Next
    
    If Count > 0 Then
        xPos = 0
        x = 0
        Do While x < Count
            CH = Buffer(x)
            x = x + 1
            If (CH And 1) = 1 Then ' transparent '
                xPos = xPos + Int(CH / 2)
            Else
                If (CH And 2) = 2 Then ' repeat pixel '
                    For xAt = 0 To Int(CH / 4)
                        Image(xPos + xAt) = Buffer(x)
                    Next
                    x = x + 1
                    xPos = xPos + Int(CH / 4) + 1
                Else ' pixel dump '
                    For xAt = 0 To Int(CH / 4)
                        Image(xPos + xAt) = Buffer(x)
                        x = x + 1
                    Next
                    xPos = xPos + Int(CH / 4) + 1
                End If
            End If
        Loop
    End If
    
    For i = 0 To UBound(Row)
        If Row(i) <> Image(i) Then
            'MsgBox yrow
        End If
    Next
    Exit Sub
Error:
    'MsgBox Err.Description
    'Resume
End Sub

' Import a sequence of image files. '
Public Sub ImportSequence(FileList As classFrameList, Center As Boolean, WhiteBG As Boolean, Compress As Boolean)
    Dim Frames() As String
    Dim Index As Integer
    Dim Subframe As New classGAFFrame
    
    Initialize
    If FileList.FrameCount > 1 Then
        FileList.GetFrames Frames()
        ImportFrame FileList.Name, Center, WhiteBG
        For Index = 0 To UBound(Frames)
            Set Subframe = New classGAFFrame
            Subframe.ImportFrame Frames(Index), Center, WhiteBG, Compress
            Subframes.Add Subframe
        Next
    Else
        ImportFrame FileList.Name, Center, WhiteBG, Compress
    End If
End Sub

' Import an image for this frame. '
Public Sub ImportFrame(Filename As String, Optional Center As Boolean = False, Optional WhiteBG As Boolean = False, Optional Compress As Boolean = False)
    Dim Index As Long
    
    Initialize
    If Not LoadBMPFile(Filename) Then
        MsgBox "There was an error loading the BMP file.  Make sure it is 256 colors.", vbInformation
        Exit Sub
    End If
    
    Width = BitmapInfo.biWidth
    Height = BitmapInfo.biHeight
    If Center Then
        PositionX = Width / 2
        PositionY = Height / 2
    End If
    
    ReDim Image(UBound(Bits))
    For Index = 0 To UBound(Bits)
        If WhiteBG Then
            If Bits(Index) = 255 Then
                Image(Index) = GAFMaskColor
            Else
                Image(Index) = Bits(Index)
            End If
        Else
            Image(Index) = Bits(Index)
        End If
    Next
    Compressed = Compress
End Sub

' Export this frame as an image. '
Public Sub ExportFrame(Filename As String)
    If Subframes.Count = 0 Then
        SaveBMPFile Filename, Image(), TAPalette(), Width, Height
    End If
End Sub

' Export all images to the specified location. '
Public Sub ExportAllImages(Location As String)
    Dim Index As Integer
    
    On Error Resume Next
    For Index = 1 To Subframes.Count
        Subframes(Index).ExportAllImages Location & "_" & Format(Index, "00")
    Next
    If Subframes.Count = 0 Then
        SaveBMPFile Location & ".bmp", Image(), TAPalette(), Width, Height
    End If
End Sub

Public Sub Display(Optional Subframe As Boolean = False, Optional SelectSubframe As Long = 1)
    On Error Resume Next
    With FrmGAFBuilder
        .TxtWidth = CStr(Width)
        .TxtHeight = CStr(Height)
        .TxtFPS = CStr(FPS)
        .ScrollXPos = CStr(PositionX)
        .ScrollYPos = CStr(PositionY)
        If Compressed Then
            .chkCompressed.Value = vbChecked
        Else
            .chkCompressed.Value = vbUnchecked
        End If
        DisplayPicture
        
        If Not Subframe Then
            If Subframes.Count <= 1 Then
                .ScrollSubframes.Max = 2
                .ScrollSubframes.Enabled = False
            Else
                .ScrollSubframes.Max = Subframes.Count
                .ScrollSubframes.Enabled = True
            End If
            SelectedSubframe = SelectSubframe
            .ScrollSubframes.Value = SelectSubframe
            Subframes(SelectedSubframe).Display True
            If Subframes.Count = 0 Then
                SelectedSubframe = 0
            End If
        End If
    End With
End Sub

' Display the frame on frmMain. '
Public Sub DisplayPicture()
    Dim x As Integer, y As Integer
    
    On Error Resume Next
    With FrmGAFBuilder
        If CenterView Then
            x = .PicFrame.ScaleWidth / 2 - Width / 2
            y = .PicFrame.ScaleHeight / 2 - Height / 2
        Else
            x = .PicFrame.ScaleWidth / 2 - PositionX
            y = .PicFrame.ScaleHeight / 2 - PositionY
        End If
        
        .PicFrame.Picture = .Picture
        .Frame.ClearTileDraw 0, 0, Width, Height, Image(), GAFMaskColor, 255, 0
        .Frame.Show .PicFrame.hdc, x, y, Width, Height, 0, 0
        .PicFrame.Picture = .PicFrame.Image
    End With
End Sub

' Import a subframe image. '
Public Sub ImportSubframe(Filename As String, Optional Center As Boolean = False, Optional WhiteBG As Boolean = False, Optional Compress As Boolean = False)
    Dim Subframe As New classGAFFrame
    
    If Subframes.Count = 0 Then ' Copy this frame over as a subframe. '
        Subframe.Width = Width
        Subframe.Height = Height
        Subframe.PositionX = PositionX
        Subframe.PositionY = PositionY
        Subframe.FPS = FPS
        Subframe.CopyImage Image()
        Subframes.Add Subframe
    End If
    
    Set Subframe = New classGAFFrame
    Subframe.ImportFrame Filename, Center, WhiteBG, Compress
    Subframes.Add Subframe
End Sub

Public Sub CopyImage(Buffer() As Byte)
    Dim Index As Long
    
    ReDim Image(UBound(Buffer))
    For Index = 0 To UBound(Buffer)
        Image(Index) = Buffer(Index)
    Next
End Sub

Public Sub DrawImage(Frame As classFastWin, x As Long, y As Long)
    Dim Index As Long
    
    If Subframes.Count = 0 Then
        Frame.ClearTileDraw x - PositionX, y - PositionY, Width, Height, Image(), GAFMaskColor, 255, 1
    Else
        For Index = 1 To Subframes.Count
            Subframes(Index).DrawImage Frame, x, y
        Next
    End If
End Sub
