Forum Liberty Basic France

Le 25/11/2020 à 11h44

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2441
Importé d'outre Atlantique par les bons offices de TSH73 voici de quoi analyser les fichiers ".BMP"
Code VB :
 
'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
 
____________________
Roro

   
Le 25/11/2020 à 23h29

Modérateur

Groupe: Modérateur

Inscrit le: 09/02/2015
Messages: 741
Pas mal...

Il est plus avancé que le mien (créé pour savoir comment écrire un bitmap en cours de jeu). A vue de nez, 12 octets commençant à la position 54, ça me fait furieusement penser à la zone qui m'était inconnue, et c'est ce qu'il semble appeler "palette". je met tout au conditionnel car j'ai juste regardé vite fait. Habituellement, sur ce type de bitmap en 24 ou 32 bits, chaque pixel est codé par ses trois composantes colorées (et une quatrième qui est probablement une transparence) et n'a donc pas besoin d'une palette. Dans l'affichage du bitmap, il y a sans doutes une inversion dans les couleurs, car on est passé d'un mauve à un vert. Je verrais plus en détails demain.

Merci pour cette trouvaille :hi
____________________
Just BASIC v2.0 :
  • utilisation courante avec GNU/Linux Mageia7+ Wine (Pas trouvé d'incohérences ou de bug de compilation à ce jour)
  • utilisation occasionnelle ou vérification/débugage difficile avec Windows XP sur un petit eeepc

   
Le 25/11/2020 à 23h47

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2441
Une petite fenêtre nommée "palette" apparaît en fin de traitement (avec les trois couleurs de base)
Quand le bmp ne contient que du noir et du blanc la fenêtre n'apparaît pas et le prog passe directement à l'affichage du bmp
Perso peut-être qu'après un an d'intenses cogitations j'arriverai à comprendre la tambouille que mijote ce code... :(
____________________
Roro

   
Le 26/11/2020 à 00h06

Modérateur

Groupe: Modérateur

Inscrit le: 09/02/2015
Messages: 741
Non, c'est pas si compliqué ;) à demain, c'est l'heure d'aller dormir !
____________________
Just BASIC v2.0 :
  • utilisation courante avec GNU/Linux Mageia7+ Wine (Pas trouvé d'incohérences ou de bug de compilation à ce jour)
  • utilisation occasionnelle ou vérification/débugage difficile avec Windows XP sur un petit eeepc

   

 |  |

1 Utilisateur en ligne : 0 Administrateur, 0 Modérateur, 0 Membre et 1 Visiteur
Utilisateur en ligne : Aucun membre connecté
Répondre
Vous n'êtes pas autorisé à écrire dans cette catégorie