-
Bitmap RLE4
I have been working on image formats lately and keep getting stuck on compressions. Right now I am hung up on the bitmap RLE4. I have the RLE8 working fine, but the rle4 never seems to work right. Anyone see anything wrong?
Code:
Private Sub DecompressRLE4(ByVal bData As Byte())
Dim pbytLen As Byte
Dim pbytValue As Byte
Dim pintLen As Integer = bData.Length - 1
Dim pintI As Integer = 0
Dim bytBuff(mintWidth - 1) As Byte
Dim pintC As Integer = 0
Dim pintRow As Integer = mintHeight - 1
Do While pintI < pintLen
pbytLen = bData(pintI)
pbytValue = bData(pintI + 1)
pintI += 2
If pbytLen = 0 Then
If pbytValue = 0 Then
'end of line
ScanLine(pintRow) = BytesToHalf(bytBuff) 'convert
pintRow -= 1
pintC = 0
ReDim bytBuff(mintWidth - 1)
ElseIf pbytValue = 1 Then
'end of bitmap
ScanLine(pintRow) = BytesToHalf(bytBuff)
Exit Do
ElseIf pbytValue = 2 Then
'delta
Dim bytX As Byte = bData(pintI)
Dim bytY As Byte = bData(pintI + 1)
pintI += 2
Dim pintY As Integer = (mintWidth \ 2) * bytY
If pintY > 0 Then
For pintL As Integer = 0 To pintY
ScanLine(pintRow) = BytesToHalf(bytBuff)
ReDim bytBuff(mintWidth)
pintRow -= 1
Next
End If
pintC += bytX
Else
'straight indexes
'pbytval is number of pix that follow
Dim bytC As Byte = 0
Do While bytC < pbytValue
Dim bytPixels As Byte = bData(pintI)
pintI += 1
Dim col1 As Byte = CByte(bytPixels And &HF)
Dim col2 As Byte = CByte((bytPixels >> 4) And &HF)
bytBuff(pintC) = col1
bytC += CByte(1)
pintC += 1
If bytC < pbytValue Then
bytBuff(pintC) = col2
pintC += 1
bytC += CByte(1)
End If
Loop
'check for padding
Dim pshrtByteLen As Short = CShort(pbytValue \ 2)
If (pshrtByteLen And 1) = 1 Then
pintI += 1
End If
End If
Else
Dim bytC As Byte
Dim col1 As Byte = CByte(pbytValue And &HF)
Dim col2 As Byte = CByte((pbytValue >> 4) And &HF)
Do While bytC < pbytLen
bytBuff(pintC) = col1
bytC += CByte(1)
pintC += 1
If bytC < pbytLen Then
bytBuff(pintC) = col2
pintC += 1
bytC += CByte(1)
End If
Loop
End If
Loop
End Sub
Private Function BytesToHalf(ByVal bytIn() As Byte) As Byte()
'convert buffer to 4 bit indexes
Dim pintI As Integer = 0
Dim pintLen As Integer = bytIn.Length - 1
Dim pbytRet(pintLen \ 2) As Byte
Dim pintC As Integer = 0
Do While pintI < pintLen
Dim byt1 As Byte = bytIn(pintI)
Dim byt2 As Byte = bytIn(pintI + 1)
pintI += 2
byt2 = byt2 << 4
Try
pbytRet(pintC) = byt1 Or byt2
Catch ex As Exception
ReDim Preserve pbytRet(pintC)
pbytRet(pintC) = byt1 Or byt2
End Try
pintC += 1
Loop
Return pbytRet
End Function