Forum Liberty Basic France
• Index
Importé d'outre Atlantique par les bons offices de TSH73 voici de quoi analyser les fichiers ".BMP"
Code VB :
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
Roro
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
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

____________________
Just BASIC v2.0 :
utilisation occasionnelle ou vérification/débugage difficile avec Windows XP sur un petit eeepc
Just BASIC v2.0 :
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...
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
Roro
Non, c'est pas si compliqué
à demain, c'est l'heure d'aller dormir !

____________________
Just BASIC v2.0 :
utilisation occasionnelle ou vérification/débugage difficile avec Windows XP sur un petit eeepc
Just BASIC v2.0 :
• Index
1 Utilisateur en ligne : 0 Administrateur, 0 Modérateur, 0 Membre et 1 Visiteur
Utilisateur en ligne : Aucun membre connecté
Utilisateur en ligne : Aucun membre connecté
Répondre
Vous n'êtes pas autorisé à écrire dans cette catégorie