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
