Je suis un debutant sous VB et j'ai besoin de quelques conseils car je suis
un peu perdu ...
Je veux faire une conversion de format : transfornmer une image BMP de
windows (en BGR /24 bits apparemment) vers le format RGB-A (sur 32bits
puisqu'qvec le canal alpha de transparence ajoute a la fin). La source est
un fichier BMP et je voudrais pouvoir recuperer les valeurs de chaque pixel
pour les convertir et les sauver dans un autre fichier.
J'ai reflechis sur les differentes possibilites mais je ne vois toujours pas
la lumiere ...
1. je dois ouvrir le fichier source en mode binaire (Open #srcNum as binary)
2. lire le contenu du fichier BMP source avec la function Get a priori (en
utilisant les structures correspondant au entetes BMP mais je ne sait pas
quels sont les types VB les plus adaptes a la lecture binaire )
3. Recuperer le contenu du fichier (les valeurs des pixels) mais vers quoi
(tableau de pixel) et comment ? (la fonction get sans doute)
4. Pour chaque pixel recuperer ses valeurs B, G et R
5. Realiser la conversion (cad reordonner les couleurs et ajouter en queue
la valeur alpha) vers une structure temporaire
6. sauver le resultat dans un fichier te mettre a jour les en-tet du fichier
destination
8. fermer les fichiers :)
Une autre methode est d'ecrire directement le resultat de la conversion
dans le fichier apres chaque pixel mais je ne pense pas que ce soit une
bonne solution car cela multiplierais inutilement les acces disques (si VB
ecrit dans un fichier apres chaque appel a la fonction Print) et donc le
temps d'execution... mais cela evite de garder en memoire une deuxieme
structure si le bmp est gros
Enfin une derniere methode serai d'utiliser les fonctions de dessins comme
bitblt ou plutot transparentbitblt et rediriger la sortie vers le fichier
destination. Mais je ne sais pas si cela est possible et surtout si le DC
(apparemment ce qui fait office d'output) peut etre un fichier. A priori
cela serait la methode la plus rapide
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Christophe
Bonjour,
1. je dois ouvrir le fichier source en mode binaire (Open #srcNum as
binary)
2. lire le contenu du fichier BMP source avec la function Get a priori (en utilisant les structures correspondant au entetes BMP mais je ne sait pas quels sont les types VB les plus adaptes a la lecture binaire )
3. Recuperer le contenu du fichier (les valeurs des pixels) mais vers quoi (tableau de pixel) et comment ? (la fonction get sans doute)
les structures
Private Type BITMAPFILEHEADER bfType As Integer bfSize As Long bfReserved1 As Integer bfReserved2 As Integer bfOffBits As Long End Type
Private Type RGBQUAD rgbBlue As Byte rgbGreen As Byte rgbRed As Byte rgbReserved As Byte End Type
Private Type BITMAPINFOHEADER biSize As Long biWidth As Long biHeight As Long biPlanes As Integer biBitCount As Integer biCompression As Long biSizeImage As Long biXPelsPerMeter As Long biYPelsPerMeter As Long biClrUsed As Long biClrImportant As Long End Type
Private Type BITMAPINFO bmiHeader As BITMAPINFOHEADER bmiColors(255) As RGBQUAD End Type
Private bittabfichier() As Byte Private mbi As BITMAPINFO
Private Sub WriteTempBitmap() Dim bifh As BITMAPFILEHEADER
Put #1, , bifh Put #1, , mbi.bmiHeader Put #1, , colorarray(0) Put #1, , colorarray(1) Put #1, , bittabfichier
Close #1 End Sub
un exemple de d'écriture de bmp pour une structure Noir&Blanc , pour la lecture tu dois redimensionner le bittabfichier et affecterla table de couleurs qui suit.
Pour dimensionner le bitmap et les variables si reportant tu dois savoir que la largeur du bitmap mbi.bmiheader.with n'est pas la largeur en memoire qu'on appel lign de balayage, la taille de la ligne de balayage s'exprime en octets et est alignée sur 32 bits, et elle s'exprime en fonction du nombre de bit par pixel bmi.bmiheader.bibitcount. La taille du tableau (bytes) de données du bitmap est donnée par
Taillelignedebalayage*bmi.bmiheader.bibitcount.
Voici les fonctions pour calculer la taille de la ligne de balayage en fonction de width et bibitcount
Public Function scanalign(pwidth&) As Long scanalign = (pwidth& + 3) And &HFFFFFFFC End Function Public Function byteperscanline(ByVal pwidth&, ByVal bitcount&) As Long Select Case bitcount&
Case 1 byteperscanline = scanalign((pwidth& + 7) 8) Case 4 byteperscanline = scanalign((pwidth& + 1) 2) Case 8 byteperscanline = scanalign(pwidth&) Case 24 byteperscanline = scanalign(pwidth& * 3) End Select
4. Pour chaque pixel recuperer ses valeurs B, G et R
Penses que c'est l'ordre d'enregistrement des octets, en couleur 24 bits
si addr& est l'adresse en memoire d'un pixel addr& contient ValeurBleu addr&+1 contient valeur Green addr&+2 contient Valeur Red
Pour le reste je te laisse chercher, en esperant t'avoir un peu eclairé
Christophe Vergon
Bonjour,
1. je dois ouvrir le fichier source en mode binaire (Open #srcNum as
binary)
2. lire le contenu du fichier BMP source avec la function Get a priori (en
utilisant les structures correspondant au entetes BMP mais je ne sait pas
quels sont les types VB les plus adaptes a la lecture binaire )
3. Recuperer le contenu du fichier (les valeurs des pixels) mais vers quoi
(tableau de pixel) et comment ? (la fonction get sans doute)
les structures
Private Type BITMAPFILEHEADER
bfType As Integer
bfSize As Long
bfReserved1 As Integer
bfReserved2 As Integer
bfOffBits As Long
End Type
Private Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type
Private Type BITMAPINFOHEADER
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type
Private Type BITMAPINFO
bmiHeader As BITMAPINFOHEADER
bmiColors(255) As RGBQUAD
End Type
Private bittabfichier() As Byte
Private mbi As BITMAPINFO
Private Sub WriteTempBitmap()
Dim bifh As BITMAPFILEHEADER
Put #1, , bifh
Put #1, , mbi.bmiHeader
Put #1, , colorarray(0)
Put #1, , colorarray(1)
Put #1, , bittabfichier
Close #1
End Sub
un exemple de d'écriture de bmp pour une structure Noir&Blanc , pour la
lecture tu dois redimensionner le bittabfichier et affecterla table de
couleurs qui suit.
Pour dimensionner le bitmap et les variables si reportant tu dois savoir que
la largeur du bitmap
mbi.bmiheader.with n'est pas la largeur en memoire qu'on appel lign de
balayage, la taille de la ligne de balayage s'exprime en octets et est
alignée sur 32 bits, et elle s'exprime en fonction du nombre de bit par
pixel bmi.bmiheader.bibitcount.
La taille du tableau (bytes) de données du bitmap est donnée par
Taillelignedebalayage*bmi.bmiheader.bibitcount.
Voici les fonctions pour calculer la taille de la ligne de balayage en
fonction de width et bibitcount
Public Function scanalign(pwidth&) As Long
scanalign = (pwidth& + 3) And &HFFFFFFFC
End Function
Public Function byteperscanline(ByVal pwidth&, ByVal bitcount&) As Long
Select Case bitcount&
Case 1
byteperscanline = scanalign((pwidth& + 7) 8)
Case 4
byteperscanline = scanalign((pwidth& + 1) 2)
Case 8
byteperscanline = scanalign(pwidth&)
Case 24
byteperscanline = scanalign(pwidth& * 3)
End Select
4. Pour chaque pixel recuperer ses valeurs B, G et R
Penses que c'est l'ordre d'enregistrement des octets, en couleur 24 bits
si addr& est l'adresse en memoire d'un pixel
addr& contient ValeurBleu
addr&+1 contient valeur Green
addr&+2 contient Valeur Red
Pour le reste je te laisse chercher, en esperant t'avoir un peu eclairé
1. je dois ouvrir le fichier source en mode binaire (Open #srcNum as
binary)
2. lire le contenu du fichier BMP source avec la function Get a priori (en utilisant les structures correspondant au entetes BMP mais je ne sait pas quels sont les types VB les plus adaptes a la lecture binaire )
3. Recuperer le contenu du fichier (les valeurs des pixels) mais vers quoi (tableau de pixel) et comment ? (la fonction get sans doute)
les structures
Private Type BITMAPFILEHEADER bfType As Integer bfSize As Long bfReserved1 As Integer bfReserved2 As Integer bfOffBits As Long End Type
Private Type RGBQUAD rgbBlue As Byte rgbGreen As Byte rgbRed As Byte rgbReserved As Byte End Type
Private Type BITMAPINFOHEADER biSize As Long biWidth As Long biHeight As Long biPlanes As Integer biBitCount As Integer biCompression As Long biSizeImage As Long biXPelsPerMeter As Long biYPelsPerMeter As Long biClrUsed As Long biClrImportant As Long End Type
Private Type BITMAPINFO bmiHeader As BITMAPINFOHEADER bmiColors(255) As RGBQUAD End Type
Private bittabfichier() As Byte Private mbi As BITMAPINFO
Private Sub WriteTempBitmap() Dim bifh As BITMAPFILEHEADER
Put #1, , bifh Put #1, , mbi.bmiHeader Put #1, , colorarray(0) Put #1, , colorarray(1) Put #1, , bittabfichier
Close #1 End Sub
un exemple de d'écriture de bmp pour une structure Noir&Blanc , pour la lecture tu dois redimensionner le bittabfichier et affecterla table de couleurs qui suit.
Pour dimensionner le bitmap et les variables si reportant tu dois savoir que la largeur du bitmap mbi.bmiheader.with n'est pas la largeur en memoire qu'on appel lign de balayage, la taille de la ligne de balayage s'exprime en octets et est alignée sur 32 bits, et elle s'exprime en fonction du nombre de bit par pixel bmi.bmiheader.bibitcount. La taille du tableau (bytes) de données du bitmap est donnée par
Taillelignedebalayage*bmi.bmiheader.bibitcount.
Voici les fonctions pour calculer la taille de la ligne de balayage en fonction de width et bibitcount
Public Function scanalign(pwidth&) As Long scanalign = (pwidth& + 3) And &HFFFFFFFC End Function Public Function byteperscanline(ByVal pwidth&, ByVal bitcount&) As Long Select Case bitcount&
Case 1 byteperscanline = scanalign((pwidth& + 7) 8) Case 4 byteperscanline = scanalign((pwidth& + 1) 2) Case 8 byteperscanline = scanalign(pwidth&) Case 24 byteperscanline = scanalign(pwidth& * 3) End Select
4. Pour chaque pixel recuperer ses valeurs B, G et R
Penses que c'est l'ordre d'enregistrement des octets, en couleur 24 bits
si addr& est l'adresse en memoire d'un pixel addr& contient ValeurBleu addr&+1 contient valeur Green addr&+2 contient Valeur Red
Pour le reste je te laisse chercher, en esperant t'avoir un peu eclairé
Christophe Vergon
Marc
> les structures
Private Type BITMAPFILEHEADER bfType As Integer bfSize As Long bfReserved1 As Integer bfReserved2 As Integer bfOffBits As Long End Type
Private Type RGBQUAD rgbBlue As Byte rgbGreen As Byte rgbRed As Byte rgbReserved As Byte End Type
Private Type BITMAPINFOHEADER biSize As Long biWidth As Long biHeight As Long biPlanes As Integer biBitCount As Integer biCompression As Long biSizeImage As Long biXPelsPerMeter As Long biYPelsPerMeter As Long biClrUsed As Long biClrImportant As Long End Type
> 4. Pour chaque pixel recuperer ses valeurs B, G et R > Penses que c'est l'ordre d'enregistrement des octets, en couleur 24 bits
si addr& est l'adresse en memoire d'un pixel addr& contient ValeurBleu addr&+1 contient valeur Green addr&+2 contient Valeur Red
Pour le reste je te laisse chercher, en esperant t'avoir un peu eclairé
Christophe Vergon
Merci,
Pour l'instant je fais mumuse avec la lecture du fichier en mode binaire mais ca morche pas ... J'ai vraiment du mal avec VB on dirait ...
Pour l'instant je cherche a observer toutes les infos de mon fichier source en les affichant dans un MsgBox et je dois avoir un pb de type dans ma lecture ou dans mon affichage
voici le code :
Dim Bmfh As BITMAPFILEHEADER Dim Bmih As BITMAPINFOHEADER
' Open fBmpInputNum = FreeFile() Open pBmpInputFile For Binary As #fBmpInputNum isBmpInputOpened = True
Get #fBmpInputNum, , Bmfh 'load the file header Get #fBmpInputNum, , Bmih 'info header follows
Au lieu d'obtenir kelkechose en rapport avec "BM" (ou &H424D) mon msgbox affiche que des zeros ...
J'ai vu quelquepart sur le net une autre definition des structures utilisant des String * 2 ou quelquechose comme ca, est-ce plus utile ?
D'avance merci
Marc
> les structures
Private Type BITMAPFILEHEADER
bfType As Integer
bfSize As Long
bfReserved1 As Integer
bfReserved2 As Integer
bfOffBits As Long
End Type
Private Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type
Private Type BITMAPINFOHEADER
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type
> 4. Pour chaque pixel recuperer ses valeurs B, G et R
>
Penses que c'est l'ordre d'enregistrement des octets, en couleur 24 bits
si addr& est l'adresse en memoire d'un pixel
addr& contient ValeurBleu
addr&+1 contient valeur Green
addr&+2 contient Valeur Red
Pour le reste je te laisse chercher, en esperant t'avoir un peu eclairé
Christophe Vergon
Merci,
Pour l'instant je fais mumuse avec la lecture du fichier en mode binaire
mais ca morche pas ...
J'ai vraiment du mal avec VB on dirait ...
Pour l'instant je cherche a observer toutes les infos de mon fichier source
en les affichant dans un MsgBox et je dois avoir un pb de type dans ma
lecture ou dans mon affichage
voici le code :
Dim Bmfh As BITMAPFILEHEADER
Dim Bmih As BITMAPINFOHEADER
' Open
fBmpInputNum = FreeFile()
Open pBmpInputFile For Binary As #fBmpInputNum
isBmpInputOpened = True
Get #fBmpInputNum, , Bmfh 'load the file header
Get #fBmpInputNum, , Bmih 'info header follows
Private Type BITMAPFILEHEADER bfType As Integer bfSize As Long bfReserved1 As Integer bfReserved2 As Integer bfOffBits As Long End Type
Private Type RGBQUAD rgbBlue As Byte rgbGreen As Byte rgbRed As Byte rgbReserved As Byte End Type
Private Type BITMAPINFOHEADER biSize As Long biWidth As Long biHeight As Long biPlanes As Integer biBitCount As Integer biCompression As Long biSizeImage As Long biXPelsPerMeter As Long biYPelsPerMeter As Long biClrUsed As Long biClrImportant As Long End Type
> 4. Pour chaque pixel recuperer ses valeurs B, G et R > Penses que c'est l'ordre d'enregistrement des octets, en couleur 24 bits
si addr& est l'adresse en memoire d'un pixel addr& contient ValeurBleu addr&+1 contient valeur Green addr&+2 contient Valeur Red
Pour le reste je te laisse chercher, en esperant t'avoir un peu eclairé
Christophe Vergon
Merci,
Pour l'instant je fais mumuse avec la lecture du fichier en mode binaire mais ca morche pas ... J'ai vraiment du mal avec VB on dirait ...
Pour l'instant je cherche a observer toutes les infos de mon fichier source en les affichant dans un MsgBox et je dois avoir un pb de type dans ma lecture ou dans mon affichage
voici le code :
Dim Bmfh As BITMAPFILEHEADER Dim Bmih As BITMAPINFOHEADER
' Open fBmpInputNum = FreeFile() Open pBmpInputFile For Binary As #fBmpInputNum isBmpInputOpened = True
Get #fBmpInputNum, , Bmfh 'load the file header Get #fBmpInputNum, , Bmih 'info header follows
Au lieu d'obtenir kelkechose en rapport avec "BM" (ou &H424D) mon msgbox affiche que des zeros ...
J'ai vu quelquepart sur le net une autre definition des structures utilisant des String * 2 ou quelquechose comme ca, est-ce plus utile ?
D'avance merci
Marc
Christophe
Voici un exemple qui n'est pas rapide mais te permettra de comprendre comment lir un bmp (colorarray est un tableau de rgbquad)
Christophe Vergon
Public Function hextolong(ByVal ch As String) As Long Dim a As String * 1 Dim b As String Dim di As Double Dim flag As Boolean
If Len(ch) > 8 Then
Exit Function Else flag = False i% = 1 Do While i% < 9 a = Mid(ch, i%, 1) b = b & hextobin(a) i% = i% + 1 Loop For i% = 1 To Len(b) a = Mid(b, i%, 1) If Len(b) = 32 And i% = 1 And a = 1 Then di = 0 flag = True Else If Len(b) = 16 And i% = 1 And a = 1 Then di = 0 flag = True Else di = di + (2 ^ CLng((Len(b) - i%))) * CLng(a) End If End If Next i% If flag Then di = di * -1 Else End If hextolong = CLng(di) End If End Function
Public Function inputlong(nfich As Integer) As Long Dim ch, tch As String Dim cb As Integer
For i% = 1 To 4 cb = Asc(Input(1, #nfich)) If cb < 10 Then tch = "0" & Hex(cb) Else tch = Hex(cb) End If ch = tch & ch Next i% inputlong = hextolong(ch) End Function
Public Function inputint(nfich As Integer) As Integer Dim ch, tch As String Dim cb As Integer
For i% = 1 To 2 cb = Asc(Input(1, #nfich)) If cb < 10 Then tch = "0" & Hex(cb) Else tch = Hex(cb) End If ch = tch & ch Next i% inputint = CInt(hextolong(ch)) End Function
Public Function inputbyte(nfich As Integer) As Byte inputbyte = Asc(Input(1, #nfich)) End Function
Public Sub readbitmap() Dim bifh As BITMAPFILEHEADER Open nomfichencours For Binary As 1 di& = LOF(1)
If bi.bmiHeader.biBitCount <= 8 Then ReDim colorarray((bifh.bfOffBits - Loc(1)) / 4 - 1) i& = 0 For i& = 0 To UBound(colorarray) colorarray(i&).rgbBlue = inputbyte(1) colorarray(i&).rgbGreen = inputbyte(1) colorarray(i&).rgbRed = inputbyte(1) colorarray(i&).rgbReserved = inputbyte(1) Next i& End If 'recupere les données Get #1, Loc(1) + 1, bittabfichier
Close #1
End Sub
Voici un exemple qui n'est pas rapide mais te permettra de comprendre
comment lir un bmp
(colorarray est un tableau de rgbquad)
Christophe Vergon
Public Function hextolong(ByVal ch As String) As Long
Dim a As String * 1
Dim b As String
Dim di As Double
Dim flag As Boolean
If Len(ch) > 8 Then
Exit Function
Else
flag = False
i% = 1
Do While i% < 9
a = Mid(ch, i%, 1)
b = b & hextobin(a)
i% = i% + 1
Loop
For i% = 1 To Len(b)
a = Mid(b, i%, 1)
If Len(b) = 32 And i% = 1 And a = 1 Then
di = 0
flag = True
Else
If Len(b) = 16 And i% = 1 And a = 1 Then
di = 0
flag = True
Else
di = di + (2 ^ CLng((Len(b) - i%))) * CLng(a)
End If
End If
Next i%
If flag Then
di = di * -1
Else
End If
hextolong = CLng(di)
End If
End Function
Public Function inputlong(nfich As Integer) As Long
Dim ch, tch As String
Dim cb As Integer
For i% = 1 To 4
cb = Asc(Input(1, #nfich))
If cb < 10 Then
tch = "0" & Hex(cb)
Else
tch = Hex(cb)
End If
ch = tch & ch
Next i%
inputlong = hextolong(ch)
End Function
Public Function inputint(nfich As Integer) As Integer
Dim ch, tch As String
Dim cb As Integer
For i% = 1 To 2
cb = Asc(Input(1, #nfich))
If cb < 10 Then
tch = "0" & Hex(cb)
Else
tch = Hex(cb)
End If
ch = tch & ch
Next i%
inputint = CInt(hextolong(ch))
End Function
Public Function inputbyte(nfich As Integer) As Byte
inputbyte = Asc(Input(1, #nfich))
End Function
Public Sub readbitmap()
Dim bifh As BITMAPFILEHEADER
Open nomfichencours For Binary As 1
di& = LOF(1)
Voici un exemple qui n'est pas rapide mais te permettra de comprendre comment lir un bmp (colorarray est un tableau de rgbquad)
Christophe Vergon
Public Function hextolong(ByVal ch As String) As Long Dim a As String * 1 Dim b As String Dim di As Double Dim flag As Boolean
If Len(ch) > 8 Then
Exit Function Else flag = False i% = 1 Do While i% < 9 a = Mid(ch, i%, 1) b = b & hextobin(a) i% = i% + 1 Loop For i% = 1 To Len(b) a = Mid(b, i%, 1) If Len(b) = 32 And i% = 1 And a = 1 Then di = 0 flag = True Else If Len(b) = 16 And i% = 1 And a = 1 Then di = 0 flag = True Else di = di + (2 ^ CLng((Len(b) - i%))) * CLng(a) End If End If Next i% If flag Then di = di * -1 Else End If hextolong = CLng(di) End If End Function
Public Function inputlong(nfich As Integer) As Long Dim ch, tch As String Dim cb As Integer
For i% = 1 To 4 cb = Asc(Input(1, #nfich)) If cb < 10 Then tch = "0" & Hex(cb) Else tch = Hex(cb) End If ch = tch & ch Next i% inputlong = hextolong(ch) End Function
Public Function inputint(nfich As Integer) As Integer Dim ch, tch As String Dim cb As Integer
For i% = 1 To 2 cb = Asc(Input(1, #nfich)) If cb < 10 Then tch = "0" & Hex(cb) Else tch = Hex(cb) End If ch = tch & ch Next i% inputint = CInt(hextolong(ch)) End Function
Public Function inputbyte(nfich As Integer) As Byte inputbyte = Asc(Input(1, #nfich)) End Function
Public Sub readbitmap() Dim bifh As BITMAPFILEHEADER Open nomfichencours For Binary As 1 di& = LOF(1)
