importing .bmp into .bas files

Programming Tools, Tips, and Tutorials.
rutger
Posts: 21
Joined: Tue Sep 16, 2008 8:27 pm

importing .bmp into .bas files

Post by rutger »

****** FINAL VERSION OF THE PROGRAM IS IN THE END OF THIS TOPIC ******

This program makes a runnable .bas file out of a .bmp. Only to be used with small images of 4 or 8 bits. A big part of the code is from a program written by Janet Terra, posted on http://justbasic.conforums.com/index.cg ... 1213647448

Code: Select all

nomainwin
    ' This program translates 4-bits and 8-bits .bmp files to a .bas file. In theory it's possible
    ' to translate even 32-bits .bmp's, but I disabled this, because the .bas would become huge
    ' as well as the loading time of the program that uses the generated code.
    ' By running the created .bas, you recreate the .bmp file
    ' -----------------------------------------------------------------------------------------
    ' I don't recomment to translate any large files. I intended this program
    ' to be used for sprites. If possible try to use 4-bits .bmp files, to keep the size of the
    ' created .bas as small as possible and to keep the loading time short.
    ' -----------------------------------------------------------------------------------------
    ' Using this program is simple, you just select the .bmp file and the destination .bas file.
    ' After that you can open the .bas and copy-paste it into your JustBasic application. Let your
    ' program run this part of code and after that open the created .bmp. On default this .bmp is
    ' saved as xxqqyyzzrutger.qyx. You can change the code to let it be saved with another name, but be
    ' carefull, because there is still no if fileexists command in the code. Be sure to use some
    ' name that nobody will have on their computer. After loading the .bmp(or .qyx) into the memory with loadbmp,
    ' you can let your program delete the .bmp.
    ' -----------------------------------------------------------------------------------------
    ' FOR THIS PROGRAM I USED A BIG PART OF A PROGRAM WITTEN BY JANET TERRA, POSTED ON
    ' http://justbasic.conforums.com/index.cgi?board=games&action=display&num=1213647448
    Filedialog "Load image to translate", "*.bmp", fileName$
    If fileName$ = "" Then End
    if len(fileName$)<5 then end
    if right$(fileName$,3)<>"bmp" then end
    Open fileName$ for Input as #F
    bitmapInfo$ = Input$(#F,LOF(#F))
    Close #F

' The Bitmap File Header
    bfType$ = Mid$(bitmapInfo$, 1, 2)
    bfSize = Value(Mid$(bitmapInfo$, 3, 4))
    bfReserved = Value(Mid$(bitmapInfo$, 7, 2))
    bfReserved = Value(Mid$(bitmapInfo$, 9, 2))
    bfOffBits = Value(Mid$(bitmapInfo$, 11, 4))

' The Bitmap Info Header
    biSize = Value(Mid$(bitmapInfo$, 15, 4))
    biWidth = Value(Mid$(bitmapInfo$, 19, 4))
    biHeight = Value(Mid$(bitmapInfo$, 23, 4))
    biPlanes = Value(Mid$(bitmapInfo$, 27, 2))
    biBitCount = Value(Mid$(bitmapInfo$, 29, 2))
    biCompress = Value(Mid$(bitmapInfo$, 31, 4))
    biSizeImage = Value(Mid$(bitmapInfo$, 35, 4))
    biXPels = Value(Mid$(bitmapInfo$, 39, 4))
    biYPels = Value(Mid$(bitmapInfo$, 43, 4))
    biClrUsed = Value(Mid$(bitmapInfo$, 47, 4))
    biClrImport = Value(Mid$(bitmapInfo$, 51, 4))
    Dim RGB$(biWidth + 8, biHeight)
    Dim ClrUsed$(256) ' Color Palette for 256 colors (8 Bit)
    bmpheader$ = left$(bitmapInfo$,54)
    z=len(bmpheader$):zz=len(bitmapInfo$)
    bmpdata$=right$(bitmapInfo$,zz-z)

    byte = bfOffBits + 1
' byte = 1079 if Bitmap = 8 (256 Colors)

    Select Case biBitCount
        Case 1
            notice "Error";chr$(13);"This program can only convert ";chr$(13);"4-bits (16color) & 8-bits(256 color) bitmaps.";chr$(13);"Convert the file and try again."
            End
        Case 4
            If biWidth Mod 8 = 0 Then
                filler = 0
            Else
                filler = Abs(8 - biWidth Mod 8)
            End If
            byteFill = 0
            Call Palette4Bit bitmapInfo$
            Call RGB4Bit bitmapInfo$, biWidth, biHeight, byte, filler, bfSize
        Case 8
            If biWidth Mod 4 = 0 Then
                filler = 0
            Else
                filler = Abs(4 - biWidth Mod 4)
            End If
            byteFill = 0
            Call Palette8Bit bitmapInfo$
            Call RGB8Bit bitmapInfo$, biWidth, biHeight, byte, filler
        Case 24
            notice "Error";chr$(13);"This program can only convert ";chr$(13);"4-bits (16color) & 8-bits(256 color) bitmaps.";chr$(13);"Convert the file and try again."
            end
        Case 32
            notice "Error";chr$(13);"This program can only convert ";chr$(13);"4-bits(16 color) & 8-bits(256 color) bitmaps.";chr$(13);"Convert the file and try again."
            end
    End Select
[savefile]
    filedialog "Save to .bas file", "*.bas", filename$
    if filename$="" then end
    if len(filename$)>3 then
        if right$(filename$,4)<>".bas" then filename$=filename$+".bas"
    else
        filename$=filename$+".bas"
    end if
    pathfound=0:savepath$=""
    for t=len(filename$) to 1 step -1
        if (mid$(filename$,t,1)="\") and (pathfound=0) then
            pthfnd=len(filename$):pthfnd=pthfnd-(len(filename$)-t)
            pathfound=1
            savepath$=left$(filename$,pthfnd)
            filename2$=right$(filename$,len(filename$)-t)
        end if
    next t
    dim info$(10, 10)
    files pathfound$,filename2$, info$(
    if val(info$(0,0))>0 then
        notice "File exists";chr$(13);"This file already exists.";chr$(13);"Choose another filename."
        goto [savefile]
    end if


    gosub [savebas]
    notice "File saved";chr$(13);"File successfully saved with the name ";chr$(13);savepath$;filename2$

    Sub XbyTrap handle$

    End
    End Sub

    Sub Palette4Bit bitmapInfo$
    clr = 0
    For i = 55 to 118  Step 4
        clr = clr + 1
        b = Asc(Mid$(bitmapInfo$, i, 1))
        g = Asc(Mid$(bitmapInfo$, i + 1, 1))
        r = Asc(Mid$(bitmapInfo$, i + 2, 1))
        ClrUsed$(clr) = Str$(r);" ";str$(g);" ";str$(b)
        Print clr, ClrUsed$(clr)
    Next i
    End Sub

    Sub Palette8Bit bitmapInfo$
        clr = 0
        For i = 55 to 1078  Step 4
            clr = clr + 1
            b = Asc(Mid$(bitmapInfo$, i, 1))
            g = Asc(Mid$(bitmapInfo$, i + 1, 1))
            r = Asc(Mid$(bitmapInfo$, i + 2, 1))
            ClrUsed$(clr) = Str$(r);" ";str$(g);" ";str$(b)
        Next i
    End Sub

    Sub RGB4Bit bitmapInfo$, biWidth, biHeight, byte, filler, bfSize
    row = biHeight
    col = -1
    n1 = byte
    For i = n1 to bfSize
        col = col + 2
        If col > biWidth + filler Then
            col = 1
            row = row - 1
        End If
        bit = Asc(Mid$(bitmapInfo$, byte, 1))
        hue1 = Int(bit / 16)
        hue2 = bit - hue1 * 16
        If col <= biWidth Then
            RGB$(col, row) = ClrUsed$(hue1 + 1)
        End If
        If col + 1 <= biWidth Then
            RGB$(col + 1, row) = ClrUsed$(hue2 + 1)
        End If
        byte = byte + 1
    Next i
End Sub

    Sub RGB8Bit bitmapInfo$, biWidth, biHeight, byte, filler
        For row = biHeight to 1 Step -1
            For col = 1 to biWidth
                RGB$(col, row) = ClrUsed$(Asc(Mid$(bitmapInfo$, byte, 1)) + 1)
                byte = byte + 1
            Next col
            byte = byte + filler
        Next row
    End Sub

[savebas]               ' save the .bmp to a .bas
    blockname$=left$(filename$,len(filename$)-4)
    open filename$ for output as #1
        print #1, chr$(39);" This program uses the following:"
        print #1, chr$(39);" Strings: bmphoofd$, bmplijn$(), bmphfd$, hoofd$, lijn$, bmpl$"
        print #1, chr$(39);" Variables: bmlijnen, bmpt, hoofd, bmpln, lijn, bmpunt, bmprogressbar, oldbmpprg, bmpprogressinterval, bmpprgscale"
        print #1, chr$(39);" Handles: #rutger, #rutger.rutger, #opslaan"
        print #1, "[bmpdatalist]"
        print #1, chr$(39);"------------ DON'T CHANGE THE FOLLOWING CODE !!!! ------------------------------"
        bmph$=""
        for t=1 to len(bmpheader$)
            bhead=asc(mid$(bmpheader$,t,1))
            bh$=str$(bhead)
            if t< len(bmpheader$) then
                bmph$=bmph$+bh$+" "
            else
                bmph$=bmph$+bh$
            end if
        next t
        print #1, "    bmphoofd$=";chr$(34);bmph$;chr$(34)
        lines=len(bmpdata$)/56:lines=int(lines)
        li=len(bmpdata$) mod 56
        if li>0 then lines=lines+1
        dim bmpd$(lines)
        dim bmpb$(lines)
        print #1, "    bmplijnen=";lines
        print #1, "    dim bmplijn$(bmplijnen)"
        for t=1 to lines
            bmpb$(t)=""
            tt=(t*56)-55
            for f=1 to 56
                bmpd$(t)=mid$(bmpdata$,tt,56)
                bm=asc(mid$(bmpd$(t),f,1))
                bm$=str$(bm)
                if f<56 then
                    bmpb$(t)=bmpb$(t)+bm$+" "
                else
                    bmpb$(t)=bmpb$(t)+bm$
                end if
            next f
            print #1, "    bmplijn$(";t;")=";chr$(34);bmpb$(t);chr$(34)
        next t
            print #1, chr$(39);"---------------------- THE FOLLOWING CODE CAN BE EDITED -------------------------------------"
            print #1, "    WindowHeight=75:WindowWidth=240"
            print #1, "    graphicbox #rutger.rutger, 10,10,210,20"
            print #1, "    open ";chr$(34);"Loading picture progress";chr$(34);" for dialog_modal as #rutger"
            print #1, "    print #rutger.rutger, ";chr$(34);"color blue;down";chr$(34)
            print #1, "    bmpprogressbar=0:oldbmpprg=-1"
            print #1, "    bmpprogressinterval=200/bmplijnen"
            print #1, "    bmpprgscale=bmpprogressinterval+1"
            print #1, "    print #rutger.rutger, ";chr$(34);"size ";chr$(34);";bmpprgscale"
            print #1, "    bmphfd$=";chr$(34);"";chr$(34)
            print #1, ""
            print #1, "    bmphfd$=";chr$(34);"";chr$(34)           ' READING THE HEADER AND RECALCULATING IT
            print #1, "    for bmpt=1 to 54"
            print #1, "        hoofd$=word$(bmphoofd$,bmpt,";chr$(34);" ";chr$(34);")"
            print #1, "        hoofd=val(hoofd$)"
            print #1, "        hoofd$=chr$(hoofd)"
            print #1, "        bmphfd$=bmphfd$+hoofd$"
            print #1, "    next bmpt"
            print #1, "    bmpl$=";chr$(34);"";chr$(34)
            print #1, "    for bmpln=1 to bmplijnen        ";CHR$(39);"READING THE PICTURE AND RECALCULATING IT"
            print #1, "        bmpprogressbar=bmpprogressbar+bmpprogressinterval"
            print #1, "        bmpprogressbar2=int(bmpprogressbar)"
            print #1, "        if bmpprogressbar2<>oldbmpprg then"
            print #1, "            print #rutger.rutger, ";chr$(34);"line ";chr$(34);";bmpprogressbar2;";chr$(34);" 0 ";chr$(34);";bmpprogressbar2;";chr$(34);" 20";chr$(34)
            print #1, "            oldbmpprg=bmpprogressbar"
            print #1, "        end if"
            print #1, "        for bmpunt=1 to 56"
            print #1, "            lijn$=word$(bmplijn$(bmpln),bmpunt,";chr$(34);" ";chr$(34);")"
            print #1, "            lijn=val(lijn$)"
            print #1, "            lijn$=chr$(lijn)"
            print #1, "            bmpl$=bmpl$+lijn$"
            print #1, "         next bmpunt"
            print #1, "    next bmpln"
            print #1, "    close #rutger"
            print #1, ""
            print #1, "    open ";chr$(34);"xxqqyyzzrutger.qyx";chr$(34);" for output as #opslaan"
            print #1, "        print #opslaan, bmphfd$+bmpl$"
            print #1, "    close #opslaan"
            print #1, "    print ";chr$(34);"Bitmap saved as xxqqyyzzrutger.qyx";chr$(34)
    close #1
    return

Function Value(x$)
    Select Case Len(x$)
        Case 1
            Value = Asc(x$)
        Case 2
            Value=Asc(Mid$(x$, 1, 1))
            Value=Value+(Asc(Mid$(x$, 2, 1)) * 256)
        Case 3
            Value=Asc(Mid$(x$, 1, 1))
            Value=Value+(Asc(Mid$(x$, 2, 1)) * 256)
            Value=Value+(Asc(Mid$(x$, 3, 1)) * 65536)
        Case 4
            Value=Asc(Mid$(x$, 1, 1))
            Value=Value+(Asc(Mid$(x$, 2, 1)) * 256)
            Value=Value+(Asc(Mid$(x$, 3, 1)) * 256 ^ 2)
            Value=Value+(Asc(Mid$(x$, 4, 1)) * 4294967296)
    End Select
End Function
Last edited by rutger on Thu Nov 06, 2008 7:15 pm, edited 1 time in total.
rutger
Posts: 21
Joined: Tue Sep 16, 2008 8:27 pm

New version of bmptobas with compression

Post by rutger »

Here's a new version of the program, the size of the .bas file can be much
smaller with bmptobascompression.
You do not have the required permissions to view the files attached to this post.
rutger
Posts: 21
Joined: Tue Sep 16, 2008 8:27 pm

Post by rutger »

Here's the newest version of bmptobas. I solved the compression, it can in some cases still give pretty big files, but mostly the filesize is ok. In case you have a bmp that is pretty empty, the .bas will be smaller than the .bmp.
You do not have the required permissions to view the files attached to this post.
rutger
Posts: 21
Joined: Tue Sep 16, 2008 8:27 pm

FINAL VERSION, "ALLTOBAS"

Post by rutger »

This is the final version of this program. I think it's 100% bug-free. The compression is good, the size of almost every .bmp is reduced. Now it's also possible to convert ANY file type you like. The loading time is also reduced :D
You do not have the required permissions to view the files attached to this post.