'read BMP pixel by pixel
'by tsh73
'compiled from various sources (sources in C and QB) to Just Basic 1.01
'10 May 2007
'released to public domain
' - to all Just Basic users who find this interesting (or useful)
'(+):   fixed 25 11 2017 for offset not (%4 == 0)

'all color depths I've seen (1, 4, 8 and 24)
'no compression
'examples created by Gimp from very old file of unknown origin YROSE.JPG

filedialog "Open BMP file", "*.bmp", fname$
open fname$ for binary as #1
print "File "+stripPath$(fname$) +" length is ";lof(#1)
 
print " ======= BMPHeader ============"
print "ValidID (first 2 bytes) is: (should be BM)";tab(45);readStr$(2)
print "fileSize";tab(45);readLong()
print "reserved";tab(45);readLong()
offset = readLong()
print "offset";tab(45);offset
print " ======= WindowsInfoHeader ==========="
print "SizeOfHeader (should be 40)";tab(45); readLong()
BMwidth = readLong()
print "width";tab(45); BMwidth
BMheight = readLong()
print "height";tab(45); BMheight
print "planes (should be 1)" ;tab(45);read2Bytes()
bpp = read2Bytes()
print "BitsPerPixel (bpp)";tab(45); bpp
CompressMethod = readLong()
print "CompressMethod";tab(45); CompressMethod;" ";word$("Uncompressed|8 Bit RLE Compression|4 Bit RLE Compression|bi_bitfields",CompressMethod+1,"|")
imagebytes = readLong()
print "imagebytes";tab(45); imagebytes
print "xres";tab(45);  readLong()
print "yres";tab(45);  readLong()
colch = readLong()
print "ColorsUsed";tab(45); colch  ' could be 0 - All Used
print "ImportantColors";tab(45);  readLong()
 
print " ======= calculated info ==========="
currPos = LOC(#1)
print "curr pos is ";tab(45);currPos
print "for palette left ";tab(45); offset - currPos
print "for palette colors ";tab(45); (offset - currPos)/4
' ==  colch
if colch = 0 then colch = (offset - currPos)/4  '???
'because it could be 0 - All Used
print "imagebytes + offset " ;tab(45); imagebytes + offset
 
byteWidth = BMwidth*bpp/8
if int(byteWidth)<> byteWidth then byteWidth= int(byteWidth)+1
actualWidth = byteWidth
if actualWidth mod 4 <>0 then  actualWidth = actualWidth + 4-actualWidth mod 4
'padded to 4 bytes
print "line length in bytes ";tab(45);actualWidth
print "imagebytes / line length in bytes ";tab(45);imagebytes / actualWidth
 
if inlist(CompressMethod, "1,2")  then
    print "Compressed bitmaps (RLE encoding) are not supported"
    close #1
    end
end if
 
if not(inlist(bpp,"1,4,8,16,24,32")) then
    print "Color depth (bits per pixel, bpp) other then 1,4,8,16,24,32 is not supported"
    close #1
    end
end if
 
if  colch = 0 then
    print " ======= No palette present ==========="
    goto [skipPalette]
end if
 
'** palette goes here
dim rpal(255),gpal(255),bpal(255),spal$(255)
for i = 0 to colch-1
    bpal(i) = readByte()
    gpal(i) = readByte()
    rpal(i) = readByte()
    spal$(i) = str$( rpal(i))+" "+str$( gpal(i))+" "+str$( bpal(i))
    'print  spal$(i)
    dummy$ = input$(#1, 1)  'skip one byte
    if i >=255 then exit for
next i
 
seek #1, offset
 
if CompressMethod = 3 then
    print "Color masks are:"
    i = 0
    redMask = ((rpal(i)*256)+ gpal(i))*256+ bpal(i)
    print "Red";  tab(8); hex$(redMask)
    i = 1
    greenMask = ((rpal(i)*256)+ gpal(i))*256+ bpal(i)
    print "green";tab(8); hex$(greenMask)
    i = 2
    blueMask = ((rpal(i)*256)+ gpal(i))*256+ bpal(i)
    print "blue"; tab(8); hex$(blueMask)
end if
 
'show palette
WindowWidth = 400
WindowHeight = 400
open "Palette" for graphics_nf_nsb as #pal
print #pal, "trapclose [endPalette]"
 
for i =0 to 15
    for j =0 to 15
        y = i*20+20
        x = j*20+20
        x1 = x+15
        y1 = y+15
        ind = i*16+j
        if ind > colch-1 then exit for
        print #pal, "backcolor ";spal$(ind)
        print #pal, "up"
        print #pal, "goto ";x;" ";y
        print #pal, "down"
        print #pal, "boxfilled ";x1;" ";y1
 
    next j
    if ind > colch-1 then exit for
next i
print #pal, "flush"      'make the graphics stick
print " ======= palette present ==========="
print colch; " colors"
print "close palette window to view image"
wait
 
[endPalette]
close #pal
 
[skipPalette]
 
startTime = time$("ms")
'** now the picture itself...
WindowWidth = BMwidth+8 ' + window border
'WindowHeight = BMheight+20  ' + window header, win2000 style
WindowHeight = BMheight+34  ' + window header, XP style
open "picture" for graphics_nf_nsb as #gr1
'print #gr1, "trapclose Quit"
print #gr1, "trapclose [gr1End]"
print #gr1, "down"       'ready to draw
print #gr1, "north ; turn 90"
 
oldInd = 999    'magic
FOR y =  BMheight-1 TO 0 step -1           ' Countdown for upsidedown image
    aLine$ = readStr$(actualWidth)
    print #gr1, "place 0 ";y
    FOR x = 0 TO BMwidth-1
    select case bpp
    case 1
        byte = asc(mid$( aLine$, int(x/8)+1, 1))
'        pos = 7 - x mod 8
'        pow2 = 2^pos
'        if (byte and pow2) <> 0 then
'            ind = 1
'        else
'            ind = 0
'        end if
        ind = ((byte and (2^(7 - x mod 8))) <> 0)
        if oldInd <> ind then
            print #gr1, "color "; spal$(ind)
            oldInd = ind
        end if
        print #gr1, "go 1"
    case 4
        byte = asc(mid$( aLine$, int(x/2)+1, 1))
        if x mod 2 <> 0 then
            ind = byte mod 16
        else
            ind = int(byte / 16)
        end if
        if oldInd <> ind then
            print #gr1, "color "; spal$(ind)
            oldInd = ind
        end if
        print #gr1, "go 1"
    case 8
        ind = asc(mid$( aLine$, x+1, 1))
        if oldInd <> ind then
            print #gr1, "color "; spal$(ind)
            oldInd = ind
        end if
        print #gr1, "go 1"
 
    case 16
        bytes = byte2Num(mid$( aLine$, 2*x+1, 2))
        'if  CompressMethod = 3 then
            r =  (bytes AND redMask) /256
            g =  (bytes AND greenMask) / 32 * 4
            b =  (bytes AND blueMask) * 8
        'end if
        print #gr1, "color ";r;" ";g;" ";b
        print #gr1, "go 1"
    case 24
        r = asc(mid$( aLine$, 3*x+3, 1))
        g = asc(mid$( aLine$, 3*x+2, 1))
        b = asc(mid$( aLine$, 3*x+1, 1))
        print #gr1, "color ";r;" ";g;" ";b
        print #gr1, "go 1"
    case 32
        r = asc(mid$( aLine$, 4*x+3, 1))
        g = asc(mid$( aLine$, 4*x+2, 1))
        b = asc(mid$( aLine$, 4*x+1, 1))
        print #gr1, "color ";r;" ";g;" ";b
        print #gr1, "go 1"
    end select
    NEXT x
next y
 
print #gr1, "flush"      'make the graphics stick
'print #gr1, "redraw"
endTime=time$("ms")
print
print "Drawing BMP (not incl. palette) took ";
print endTime-startTime; " milliseconds"
close #1
 
wait
 
[gr1End]
close #gr1
 
end
 
' some functions ********************************************8
function readByte()
    readByte = asc(input$(#1, 1))
end function
 
function readLong()
    readLong = byte2Num(input$(#1, 4))
end function
 
function read2Bytes()
    read2Bytes = byte2Num(input$(#1, 2))
end function
 
function readStr$(n)
     readStr$ = input$(#1, n)
end function
 
function byte2Num(c$)
    res = 0
    for i = len(c$) to 1 step -1    'lower byte first
        res = res * 256+asc(mid$(c$,i,1))
    next i
    byte2Num = res
end function
 
function stripPath$(fname$)
    found = 0
    for i = len(fname$) to 1 step -1
        c$=mid$(fname$,i,1)
        'print i; c$,
        if c$="\" then
            found = 1
            exit for
        end if
    next i
    if found then
         stripPath$ = mid$(fname$,i+1)
    else
        stripPath$ = fname$
    end if
end function
 
function inlist(aVal, list$)
    list$ = ","+list$+","
    inlist = (instr(list$, ","+str$(aVal)+",")<>0)
end function
 
Function hex$(n)
    h$ = ""
    do
        h$ = mid$("0123456789ABCDEF", (n mod 16)+1, 1) + h$
        n = int(n/16)
    loop while n > 0
    hex$ = h$
End Function