Soyez le premier à donner votre avis sur cette source.
Vue 16 243 fois - Téléchargée 44 707 fois
'Module créé par Yves Demirdjian le 17/02/2007 'Ce module permet d'ouvrir une image Bitmap Windows (signé "BM"). OS/2 non pris en charge 'Bitmaps pris en charge : Profondeur 24,8,4,1 bits, aucune compression 'Pas d'optimisation performance 'Ce module a juste pour but de montrer la structure d'un tel fichier Option Strict On Imports System.Text.Encoding Imports System.Runtime.InteropServices Module ModBmp Public OutImage As Image Public BmpFileInfo As BmpInfo Public Structure BmpInfo Public TailleDeLImage As Integer Public OffSetImg As Integer Public LargeurImg As Integer Public HauteurImg As Integer Public NbDeBitParPixel As Integer Public Compression As String Public TailleDeLImageAcRemplissage As Integer Public ResolutionHorizontale As Integer Public ResolutionVerticale As Integer Public NbCouleurPalette As Integer Public NbCouleurImportantes As Integer End Structure Public Sub OpenBmpFile(ByVal File As String) Dim TblBytes() As Byte 'Buffer (tableaud de bytes) Dim StreamBmpRead As New IO.FileStream(File, IO.FileMode.Open, IO.FileAccess.Read, IO.FileShare.Read) 'Ouvre un flux de lecture 'On lit l'entête et on vérifie que le fichier est bien signé BMP ReDim TblBytes(1) StreamBmpRead.Read(TblBytes, 0, 2) If ASCII.GetString(TblBytes) <> "BM" Then MsgBox("Ce fichier n'est pas un fichier BMP Windows valide, celui peut être compatible OS/2 non pris en charge dans ce programme!", MsgBoxStyle.Critical Or MsgBoxStyle.OkOnly, "Erreur") : Exit Sub 'On lit la taille de l'image contenue dans 4 octets (non fiable) ReDim TblBytes(3) StreamBmpRead.Read(TblBytes, 0, 4) BmpFileInfo.TailleDeLImage = BytesToInt(TblBytes, 4) 'On lit la valeur qui nous dit où commencer la lecture des données de l'image (offset) StreamBmpRead.Read(TblBytes, 0, 4) StreamBmpRead.Read(TblBytes, 0, 4) BmpFileInfo.OffSetImg = BytesToInt(TblBytes, 4) 'On vérifie que l'entête à bien une valeure de 40 octets StreamBmpRead.Read(TblBytes, 0, 4) If BytesToInt(TblBytes, 4) <> 40 Then MsgBox("L'entête du fichier Bmp n'est pas valide, lecture annulée", MsgBoxStyle.Critical Or MsgBoxStyle.OkOnly, "Erreur") : Exit Sub 'On lit la valeur de la largeur de l'image StreamBmpRead.Read(TblBytes, 0, 4) BmpFileInfo.LargeurImg = BytesToInt(TblBytes, 4) 'On lit la valeur de la hauteur de l'image StreamBmpRead.Read(TblBytes, 0, 4) BmpFileInfo.HauteurImg = BytesToInt(TblBytes, 4) 'On lit la valeur du plan ReDim TblBytes(1) StreamBmpRead.Read(TblBytes, 0, 2) If BytesToInt(TblBytes, 2) <> 1 Then MsgBox("La valeur du plan n'est pas valide, la lecture du fichier continue mais pourra poser problème.", MsgBoxStyle.Critical Or MsgBoxStyle.OkOnly, "Erreur") 'On lit la valeur du nombre de bit par pixel StreamBmpRead.Read(TblBytes, 0, 2) BmpFileInfo.NbDeBitParPixel = BytesToInt(TblBytes, 2) 'On lit la valeur de la compréssion utilsée ReDim TblBytes(3) StreamBmpRead.Read(TblBytes, 0, 4) Select Case BytesToInt(TblBytes, 4) Case 0 BmpFileInfo.Compression = "Aucune" Case 1 BmpFileInfo.Compression = "RLE-8" Case 2 BmpFileInfo.Compression = "RLE-4" Case 3 BmpFileInfo.Compression = "BitField" Case Else BmpFileInfo.Compression = "Inconnue" End Select 'On lit la valeur de la taille de l'image avec le remplissage StreamBmpRead.Read(TblBytes, 0, 4) BmpFileInfo.TailleDeLImageAcRemplissage = BytesToInt(TblBytes, 4) 'On lit la valeur de la resolution horizontale en pixel par metre (non fiable) StreamBmpRead.Read(TblBytes, 0, 4) BmpFileInfo.ResolutionHorizontale = BytesToInt(TblBytes, 4) 'On lit la valeur de la resolution verticale en pixel par metre (non fiable) StreamBmpRead.Read(TblBytes, 0, 4) BmpFileInfo.ResolutionVerticale = BytesToInt(TblBytes, 4) 'On lit la valeur du nombre de couleur contenu dans la palette StreamBmpRead.Read(TblBytes, 0, 4) BmpFileInfo.NbCouleurPalette = BytesToInt(TblBytes, 4) 'On lit la valeur du nombre de couleur contenu dans l'image StreamBmpRead.Read(TblBytes, 0, 4) BmpFileInfo.NbCouleurImportantes = BytesToInt(TblBytes, 4) 'Lecture de la palette de couleur si la condition est vérifiée Dim TblPalette() As Byte If BmpFileInfo.NbDeBitParPixel <= 8 Then ReDim TblPalette(CInt(4 * 2 ^ BmpFileInfo.NbDeBitParPixel - 1)) StreamBmpRead.Read(TblPalette, 0, TblPalette.Length) End If 'Préparation de l'image Dim Image As New System.Drawing.Bitmap(BmpFileInfo.LargeurImg, BmpFileInfo.HauteurImg) 'Lecture de l'image StreamBmpRead.Position = BmpFileInfo.OffSetImg 'On commence où commence l'image 'Indique si on doit ajouter des octets pour avoir un multiple de 4 Dim NbAddOctet As Integer = 0 Dim BitEnTrop As Integer = 0 'On prépare en fonction de la profondeur de l'image Dim Mode24 As Byte = CByte(IIf(BmpFileInfo.NbDeBitParPixel = 24, 3, 1)) Dim NbOctetBuffer As Integer Select Case BmpFileInfo.NbDeBitParPixel Case 24 NbOctetBuffer = 3 * BmpFileInfo.LargeurImg Case 8 NbOctetBuffer = BmpFileInfo.LargeurImg Case 4 If Int(BmpFileInfo.LargeurImg / 2) < (BmpFileInfo.LargeurImg / 2) Then NbOctetBuffer = CInt(Int(BmpFileInfo.LargeurImg / 2) + 1) Else NbOctetBuffer = CInt(Int(BmpFileInfo.LargeurImg / 2)) If (BmpFileInfo.LargeurImg / 4) > (Int(BmpFileInfo.LargeurImg / 4)) Then BitEnTrop = 4 Case 1 If Int(BmpFileInfo.LargeurImg / 8) < (BmpFileInfo.LargeurImg / 8) Then NbOctetBuffer = CInt(Int(BmpFileInfo.LargeurImg / 8) + 1) Else NbOctetBuffer = CInt(BmpFileInfo.LargeurImg / 8) BitEnTrop = (NbOctetBuffer * 8 - BmpFileInfo.LargeurImg) Case Else NbOctetBuffer = 1 End Select If (NbOctetBuffer / 4) > (Int(NbOctetBuffer / 4)) Then NbAddOctet = CInt(Int(NbOctetBuffer / 4) + 1) * 4 - NbOctetBuffer Dim X, Y As Integer 'Position du Pixel a afficher X = 0 'On commence à gauche Y = (BmpFileInfo.HauteurImg - 1) 'On commence en bas de l'image pour l'image (le bas de l'image est stocké en haut) ReDim TblBytes(NbOctetBuffer - 1) 'Buffer en fonction de la largeur Dim ValMaxRead As Integer 'Variable indiquant le nombre d'octets lu Do While StreamBmpRead.Position < StreamBmpRead.Length 'Boucle tant qu'on est pas à la fin du fichier FrmMain.Text = CStr(CInt(StreamBmpRead.Position / StreamBmpRead.Length * 100)) & "% chargé" 'Indiquation utilisateur ValMaxRead = StreamBmpRead.Read(TblBytes, 0, NbOctetBuffer) For I As Integer = 0 To CInt((ValMaxRead / Mode24 - 1)) 'Selon la profondeur et le Buffer Select Case BmpFileInfo.NbDeBitParPixel Case 24 'RGB codé sous 3 octets, pour un mode 32bit il faut rajouter Alpha (je n'ai pas codé ce mode car il est peu présent il faut juste prendre en compte un octet de plus) Image.SetPixel(X, Y, Color.FromArgb(TblBytes(2 + (3 * I)), TblBytes(1 + (3 * I)), TblBytes(0 + (3 * I)))) 'On affiche le pixel (ARGB où A = 255) PixelSuivant(X, Y) Case 8 'Image en 256 couleurs, 1 octet = Index de couleur dans la palette Image.SetPixel(X, Y, Color.FromArgb(TblPalette(TblBytes(I) * 4 + 2), TblPalette(TblBytes(I) * 4 + 1), TblPalette(TblBytes(I) * 4))) PixelSuivant(X, Y) Case 4 ' Ouvre une image en 16 couleurs : chaque octet contient 2 pixels donc codé sous 4 bit, puis trouvé l'index dans la palette pour savoir la couleur Dim Octet1, Octet2 As Byte Octet2 = TblBytes(I) And CByte(15) Octet1 = TblBytes(I) And CByte(240) : Octet1 >>= 4 Image.SetPixel(X, Y, Color.FromArgb(TblPalette(Octet1 * 4 + 2), TblPalette(Octet1 * 4 + 1), TblPalette(Octet1 * 4))) PixelSuivant(X, Y) If Not (BitEnTrop = 4 And X = 0 And Octet2 = 0) Then Image.SetPixel(X, Y, Color.FromArgb(TblPalette(Octet2 * 4 + 2), TblPalette(Octet2 * 4 + 1), TblPalette(Octet2 * 4))) PixelSuivant(X, Y) End If Case 1 'Ouvre une image en N&B : il faut traduire chaque octet en huit octets de valeurs 1 ou 0 Dim Octet As Byte Dim ByteOperation As Byte = 128 If I <> (TblBytes.Length - 1) Then For K As Integer = 0 To 7 Octet = TblBytes(I) And ByteOperation Octet >>= (7 - K) ByteOperation >>= 1 Image.SetPixel(X, Y, Color.FromArgb(TblPalette(Octet * 4 + 2), TblPalette(Octet * 4 + 1), TblPalette(Octet * 4))) PixelSuivant(X, Y) Next Else For K As Integer = 0 To (7 - BitEnTrop) Octet = TblBytes(I) And ByteOperation Octet >>= (7 - K) ByteOperation >>= 1 Image.SetPixel(X, Y, Color.FromArgb(TblPalette(Octet * 4 + 2), TblPalette(Octet * 4 + 1), TblPalette(Octet * 4))) PixelSuivant(X, Y) Next End If End Select Next I If NbAddOctet > 0 Then StreamBmpRead.Read(TblBytes, 0, NbAddOctet) Application.DoEvents() 'Pour laisser l'application afficher le texte Loop 'Fermer le stream StreamBmpRead.Close() 'Remet le titre d'origine FrmMain.Text = "Ouverture d'images en natif" 'Affiche l'image FrmMain.PbPicture.Image = Image 'Libérer les ressources Image = Nothing TblBytes = Nothing TblPalette = Nothing 'Affichage du texte de la structure de l'image FrmMain.TxtInfo.Text = "Headers >> " & vbCrLf & "Compression utilisée : " & BmpFileInfo.Compression & vbCrLf & _ "Hauteur de l'image en pixel : " & BmpFileInfo.HauteurImg & vbCrLf & _ "Largeur de l'image en pixel : " & BmpFileInfo.LargeurImg & vbCrLf & _ "Nombre de couleurs importantes : " & BmpFileInfo.NbCouleurImportantes & vbCrLf & _ "Nombre de couleurs de la palette : " & BmpFileInfo.NbCouleurPalette & vbCrLf & _ "Profondeur de l'image (en bits) : " & BmpFileInfo.NbDeBitParPixel & vbCrLf & _ "Offset du début des données de l'image : " & BmpFileInfo.OffSetImg & vbCrLf & _ "Résolution horizontale : " & BmpFileInfo.ResolutionHorizontale & vbCrLf & _ "Résolution verticale : " & BmpFileInfo.ResolutionVerticale & vbCrLf & _ "Taille de l'image (approx en octets) : " & BmpFileInfo.TailleDeLImage & vbCrLf & _ "Taille de l'image avec remplissage (approx en octets) : " & BmpFileInfo.TailleDeLImageAcRemplissage End Sub Private Sub PixelSuivant(ByRef X As Integer, ByRef Y As Integer) X += 1 If X > (BmpFileInfo.LargeurImg - 1) Then 'Si on atteint la fin de la ligne X = 0 Y -= 1 End If End Sub Private Function BytesToInt(ByVal TblBytes() As Byte, ByVal Len As Integer) As Integer 'Comme son nom l'indique cette fonction transforme un tableau de bytes en Integer, il sagit d'une copie mémoire. Dim Number As Integer Dim MyGC As GCHandle = GCHandle.Alloc(Number, GCHandleType.Pinned) Dim AddofLongValue As IntPtr = MyGC.AddrOfPinnedObject() Marshal.Copy(TblBytes, 0, AddofLongValue, Len) Number = Marshal.ReadInt32(AddofLongValue) MyGC.Free() Return Number End Function End Module
25 nov. 2009 à 16:23
merci pour cette source qui fait comprendre beaucoup de chose, elle va mettre utile pour modifier les bit de poids faible d'une image bmp!
17 févr. 2007 à 19:21
17 févr. 2007 à 19:12
@+
17 févr. 2007 à 15:11
17 févr. 2007 à 15:00
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.