[syslinux] VB Code to convert BMP to LSS for splash screens

[Paul Shebanow]

The following code can be used to convert a 256 color BMP to LSS format for use as a SYSLINUX/ISOLINUX/PXELINUX Splash screen. The bitmap must be LESS than 640 pixels wide (bug) and only uses the first 16 colors.  CorelDraw and PhotoShop are good for re-palletizing and dithering.

Paul Shebanow
pshebanow at iqcorp.com

--- Begin Code ---

Type RGBColor4
    cBlue As Byte
    cGreen As Byte
    cRed As Byte
    cReserved As Byte
End Type

Type RGBColor3
    cRed As Byte
    cGreen As Byte
    cBlue As Byte
End Type

Type bmpHeader
    fileType As Integer
    fileSize As Long
    fileReserved1 As Integer
    fileReserved2 As Integer
    fileOffsetBits As Long
    iSize As Long
    iWidth As Long
    iHeight As Long
    iPlanes As Integer
    iBitCount As Integer
    iCompression As Long
    iSizeImage As Long
    iXPelsPerMeter As Long
    iYPelsPerMeter As Long
    iClrUsed As Long
    iClrImportant As Long
End Type

Type lssHeader
    magic As Long
    iWidth As Integer
    iHeight As Integer
    colors(1 To 16) As RGBColor3
End Type

Function PadHex(myByte As Byte) As String
    Dim tmpStr As String
    
    tmpStr = Hex$(myByte)
    If Len(tmpStr) < 2 Then tmpStr = "0" & tmpStr
    PadHex = tmpStr
End Function

Sub convertBMPtoLSS()
    Dim fileSystem
    Dim myBmpHeader As bmpHeader
    Dim myBmpPallete(256) As RGBColor4
    Dim myBmpData() As Byte
    Dim myLssHeader As lssHeader
    Dim DebugStr As String
    Dim filename As String
    
    Dim iColor As Byte
    Dim myByte As Byte
    Dim nCount As Integer
    Dim run As Integer
    Dim erun As Byte
    Dim current As Byte
    Dim prev As Byte
    Dim rowBuffer() As Byte
    
    Dim dBitmapRow As String
    Dim dBuffer As String
    Dim dLSSRow As String
    
    sourcefile = "I:\PXE Server\splash.bmp"
    outputfile = "I:\PXE Server\splash.lss"
    
    Set fileSystem = CreateObject("Scripting.FileSystemObject")
    If fileSystem.FileExists(sourcefile) Then
        Open sourcefile For Binary As #1
        If fileSystem.FileExists(outputfile) Then fileSystem.DeleteFile (outputfile), True
        Open outputfile For Binary As #2
    Else
        DebugStr = "Failure"
        Exit Sub
    End If
    
    Get #1, , myBmpHeader
    Get #1, , myBmpPallete
    ReDim myBmpData(myBmpHeader.iWidth + 2, myBmpHeader.iHeight) As Byte
    Get #1, , myBmpData
    Close #1
    
    With myBmpHeader
        DebugStr = .iWidth & "x" & .iHeight & ", " & .iBitCount & "bit "
        myLssHeader.magic = &H1413F33D
        myLssHeader.iWidth = .iWidth
        myLssHeader.iHeight = .iHeight
        For I = 1 To 16 'Get the first 16 colors from the pallete
            myLssHeader.colors(I).cRed = myBmpPallete(I).cRed \ 4
            myLssHeader.colors(I).cGreen = myBmpPallete(I).cGreen \ 4
            myLssHeader.colors(I).cBlue = myBmpPallete(I).cBlue \ 4
            'Debug.Print I & " " & PadHex(myLssHeader.colors(I).cRed) & " " & PadHex(myLssHeader.colors(I).cGreen) & " " & PadHex(myLssHeader.colors(I).cBlue)
        Next I
        
        Put #2, , myLssHeader  'Write the header
        Y = 1
        For Y = .iHeight To 1 Step -1
            nCount = 0
            prev = 0
            current = 0
            run = 0
            dBitmapRow = ""
            dBuffer = ""
            dLSSRow = ""
            ReDim rowBuffer(0 To .iWidth)
            
            For X = 1 To (.iWidth)
                'dBitmapRow = dBitmapRow & Hex(myBmpData(X, Y)) '& " "
                If myBmpData(X, Y) = current Then
                    run = run + 1
                Else
                    If run > 0 Then GoSub EnqueRun
                    prev = current
                    current = myBmpData(X, Y)
                    run = 1
                End If
            Next X
            GoSub EnqueRun
            If nCount Mod 2 = 1 Then nCount = nCount + 1
            'For I = 0 To (nCount - 1)
            '    dBuffer = dBuffer & Hex$(rowBuffer(I)) & " "
            'Next I
            For I = 0 To nCount Step 2
                rowBuffer(I \ 2) = (rowBuffer(I + 1) * 16) Or rowBuffer(I)
                'dLSSRow = dLSSRow & " " & PadHex(rowBuffer(I \ 2)) & " "
            Next I
            
            'If Y >= 5 And Y <= 7 Then
            '    Debug.Print "---"
            '    Debug.Print dBitmapRow
            '    Debug.Print dBuffer
            '    Debug.Print dLSSRow
            'End If
            ReDim Preserve rowBuffer(0 To ((nCount \ 2) - 1))
            Put #2, , rowBuffer
        Next Y
    End With
    Close #2    ' Close file.
    Exit Sub
    
EnqueRun:
    'If Y >= 5 And Y <= 7 Then
    '    Debug.Print "Color: " & Hex(current) & "  Run: " & run & " " & Hex(run)
    'End If
    If prev <> current Then
        rowBuffer(nCount) = current
        nCount = nCount + 1
        run = run - 1
    End If
    While run > 0
        If run < 16 Then
            rowBuffer(nCount) = current
            rowBuffer(nCount + 1) = run
            nCount = nCount + 2
            run = 0
        Else
            rowBuffer(nCount) = current
            rowBuffer(nCount + 1) = 0
            If run > 271 Then
                erun = 255
                run = run - 271
            Else
                erun = run - 16
                run = 0
            End If
            rowBuffer(nCount + 2) = (erun And &HF)
            rowBuffer(nCount + 3) = (erun \ 16)
            nCount = nCount + 4
        End If
    Wend
    Return
    
End Sub