Bitmap_Mono

Bon, quitte à me prendre un bide, autant que ce soit avec un sujet qui n'intéresse guère que moi, à savoir un peu de VBA, le langage VisualBasic version 6, intégré à la suite Office (celle de Kro$).

L'idée de ce sujet fait un peu suite aux deux précédentes, "En Toutes Lettres" et "DrawFlag" car l'on reste dans le décryptage d'images Bitmap.. Vous pouvez relire la seconde partie de "En Toutes Lettres" en préliminaire à ce code..

Un Afficheur d'images monochromes sous Excel

Intro

Soit une image enregistrée au format BitMap Monochrome. Chaque pixel n'occupe qu'un bit d'information, et n'a que deux états: allumé ou éteint. Dans un octet l'on encode ainsi 8 pixels consécutifs. L'en-tête de 62 octets contient un certain nombre d'informations. Dans le cas d'un seul plan (le bitmap peut en contenir plusieurs, je n'ai jamais vu d'exemple l'exploitant), certaines sont redondantes. Chaque information est écrite dans 2 à 4 octets consécutifs, autant rédiger une fonction Valr(Position de départ, Nombre d'octets) qui gèrera ça..

Après quelques vérifications, récupérons grâce à notre fonction les largeur: LX, hauteur: LY, et taille de la zone Data: DSz. Pourquoi ? Déjà la première raison est simple, la largeur de stockage n'est pas LX, mais évidemment au moins le premier multiple de 8 immédiatement supérieur ou égal à LX. C'est même davantage le premier multiple de 32, la partie inutilisée étant en fin de ligne. Un autre moyen de calculer cette largeur, c'est de diviser la taille de la zone Data DSz par le nombre de lignes LY (c'est NX) :)

Pour rester compatible avec les versions 2000 à 2007 d'Excel, la taille maximale de l'image sera bridée à 256 en largeur (et 512 en hauteur).

Préparation de la Feuille

Nous allons "habiller" la première feuille du classeur d'Excel (Feuil1) :

- Doubler la hauteur de la première ligne, et figer le volet sous elle.
Ne pas figer le volet des colonnes.

- Dans cette première ligne, créer deux Boutons (boîte à outils Contrôles et non Formulaire). Le premier (en B1) sera nommé "C_Charge" et marqué "Charger une image". Le second (en F1) sera nommé "C_Efface" et marqué "Effacer la Feuille".

- Faire un clic droit sur l'un d'eux, et choisir "Associer le code" pour démarrer l'éditeur VBA. Effacer le corps "Private Sub C_**_Click() .. End Sub" ainsi que toute autre ligne qui se trouverait dans la feuille.

- Copier le code ci-dessous, et le coller à la place, dans la Feuille.

Le Code

' ----------------
' Bouton "Charger"
' ----------------
Private Sub C_Charge_Click()
Dim FD As FileDialog
Set FD = Application.FileDialog(msoFileDialogFilePicker)
With FD
    .AllowMultiSelect = False: .ButtonName = "Charger"
    .Filters.Clear: .Filters.Add "BMP (mono)", "*.BMP": .Show
End With
If FD.SelectedItems.Count Then Photo FD.SelectedItems(1)
End Sub

' ----------------
' Bouton "Effacer"
' ----------------
Private Sub C_Efface_Click()
Photo ""
End Sub

' -----------------------
' Procédure de Décryptage
' -----------------------
Sub Photo(Fic$)
On Error Resume Next
Err.Number = 0
' Nettoyage Feuil1
With ThisWorkbook.Sheets(1).Range("A2:IV65536")
    .EntireRow.Hidden = False: .EntireColumn.Hidden = False
    If Fic$ = "" Then
        .ColumnWidth = 10.71: .RowHeight = 12.75
    Else
        .ColumnWidth = 0.5: .RowHeight = 4.5
    End If
    .Interior.ColorIndex = xlNone: .Borders.LineStyle = xlNone
    .Borders(xlDiagonalDown).LineStyle = xlNone
    .Borders(xlDiagonalUp).LineStyle = xlNone
End With
With ThisWorkbook.Sheets(1)
    .C_Efface.Left = 244.5: .C_Charge.Left = 64.5
End With
If Fic$ = "" Then Exit Sub
' Fichier
Dim F As Boolean
Open Fic$ For Random As #1 Len = 1
' AnaLyse Hdr
F = (Valr(1, 2) = 19778) And (Valr(27, 2) = 1) And (Valr(29, 2) = 1)
LX& = Valr(19, 4): LY& = Valr(23, 4): DSz& = Valr(35, 4)
F = F And (LX& < 257) And (LY& < 513)
If F Then
    With ThisWorkbook.Sheets(1)
        ' Préparation
        If LX& < 256 Then _
            .Range(.Cells(1, LX& + 1), .Cells(1, 256)).EntireColumn.Hidden = True
        .Range(.Cells(LY& + 2, 1), .Cells(65536, 1)).EntireRow.Hidden = True
        ' Décodage
        Dim P As String * 1
        Posi& = LOF(1) - DSz& + 1: NX& = DSz& / LY&
        For Y& = LY& + 1 To 2 Step -1
            Seek #1, Posi&: Posi& = Posi& + NX&
            For X& = 0 To LX& - 1
                X2& = X& Mod 8: If X2& = 0 Then Get #1, , P: Msq& = Asc(P)
                .Cells(Y&, X& + 1).Interior.Color = IIf(Msq& And (2 ^ (7 - X2&)), &HFFFFFF, 0)
            Next X&
        Next Y&
    End With
    If Err.Number Then
        MsgBox "Effectué avec problème", vbCritical
    Else
        MsgBox "Effectué correctement", vbInformation
    End If
Else
    MsgBox "Bad File..", vbCritical
End If
Close #1
End Sub

' ----------------------------------------------------
' FCT: Récupère le Numérique sur Nb Octets depuis Posi
' ----------------------------------------------------
Function Valr(Posi, Nb)
V& = 0
Dim P As String * 1
For N& = (CLng(Posi) + Nb - 1) To CLng(Posi) Step -1
    Get #1, N&, P: V& = V& * 256& + Asc(P)
Next N&
Valr = V&
End Function

- Sauvegarder le Classeur sous l'extension ".XLS", ou ".XLSM" (2007) mais pas ".XLSX" (macro-free de 2007) qui perdra le code !!!

Image de Test

Voici une image de test. Peu importe son contenu, tant qu'il est cohérent, reconnaissable. Que le tour soit délimité servira à vérifier que toute l'image est exactement prise en compte.

Pour utiliser cette image, enregistrez-la (ce sera un jpeg), et ouvrez-la dans MSPaint. Réenregistrez-la au format Bitmap Monochrome !!

Utilisation

Dans l'éditeur VBA, repérer les boutons "Play (triangle)", "Pause (deux bâtons verticaux)", et "Stop (carré)" ainsi que l'équerre "Mode Création". Si le Pause et Stop sont grisés, cliquer sur l'équerre pour quitter le mode création. Si un message "sécurité élevée" empêche de quitter ce mode création, modifier dans Excel le niveau sur "Moyen" (Menu Outils > Macros), quitter Excel, et revenir.

Depuis Excel, cliquer sur "Effacer". Les deux boutons bougeront sans doute un peu. Réenregistrer pour la dernière fois.

Cliquer sur "Charger". Une fenêtre de sélection de fichier apparaît. Choisir l'image de test, et attendre :P

Rem: il n'est pas nécessaire d'effacer entre deux chargements d'images..

-MyLzz59-

(Rem: je crée une nouvelle rubrique pour l'info..)