OUVERTURE D'UN FICHIER BITMAP EN NATIF

'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

Télécharger le zip

17 février 2007 15:10:42 :

Permet de se déplacer dans l'image si celle-ci est plus grande que le contrôle.

17 février 2007 18:27:16 :

Correction de la correction ;)