Étude des propriétés hydriques et des mécanismes d ... - sacre

Annexes
If InfoBMP.biWidth > 254 Then
Close #1
MsgBox ("fichier non valide ... il ne peut pas être affiché !!!")
Exit Sub
End If
If InfoFile.bfType 19778 Then
Close #1
MsgBox ("fichier non valide ... ce n'est pas un .BMP !!!")
Exit Sub
End If
If InfoBMP.biBitCount 24 Then
Close #1
MsgBox ("fichier non valide ... les pixels ne sont pas définis sur 8 Bits")
Exit Sub
End If
IndexLecture = InfoFile.bfOffBits
taillelignepixel = InfoBMP.biWidth + (InfoBMP.biWidth Mod 4)
IndexX = 1
Indexy = InfoBMP.biHeight
Do While Not EOF(1)
For i = 1 To (InfoBMP.biWidth * 3) Step 3
Get #1, IndexLecture + i, Pix
Cells(Indexy, IndexX).Interior.Color = RGB(Pix.Rouge, Pix.Vert, Pix.Bleu)
IndexX = IndexX + 1
Next i
IndexX = 1
If Indexy = 1 Then
Exit Do
Else
Indexy = Indexy - 1
End If
IndexLecture = IndexLecture + (InfoBMP.biWidth * 3) + (InfoBMP.biWidth Mod 4) 'on considere seulement
le 24 Bit > 3*octet
Loop
Close #1
End Sub
Function SeuillageBinaire(coul As Byte, niveau As Byte) As Byte
If coul < niveau Then
coul = 0
Else
coul = 255
End If
SeuillageBinaire = coul
End Function
Function Seuillage(coul As Byte, niveau As Byte) As Byte
If coul < niveau Then coul = 0
Seuillage = coul
End Function
Sub modifieBMP()
Dim InfoFile As BITMAPFILEHEADER
Dim InfoBMP As BITMAPINFOHEADER
Dim Pix As Pixel
Dim IndexLecture As Long
Dim ValSeuilR As Byte, ValSeuilV As Byte, ValSeuilB As Byte
Open "c:\temp\courbe.bmp" For Binary Access Read Write As #1
Get #1, StartBITMAPFILEHEADER, InfoFile
Get #1, StartBITMAPINFOHEADER, InfoBMP
If InfoBMP.biBitCount 24 Then
222
Kévin Beck (2006)