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

Annexes
Pix.Bleu = Seuillage(Pix.Bleu, ValSeuilB)
Else
Pix.Rouge = 0
Pix.Vert = 0
Pix.Bleu = 0
End If
Put #1, IndexLecture + i, Pix
Next i
Else
For i = 1 To (InfoBMP.biWidth * 3) Step 3
Pix.Rouge = 0
Pix.Vert = 0
Pix.Bleu = 0
Put #1, IndexLecture + i, Pix
Next i
End If
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
Application.ScreenUpdating = True
End If
Close #1
End Sub
Sub TraceCourbeBMP()
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
FicTraite = Application.GetOpenFilename("Fichier source (*.*), *.BMP")
Application.ScreenUpdating = False ' Désactivation de la mise à jour de l'écran
If FicTraite False Then
Open FicTraite For Binary Access Read Write As #1
Get #1, StartBITMAPFILEHEADER, InfoFile
Get #1, StartBITMAPINFOHEADER, InfoBMP
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 3*8 Bits")
Exit Sub
End If
IndexLecture = InfoFile.bfOffBits
taillelignepixel = InfoBMP.biWidth + (InfoBMP.biWidth Mod 4)
Indexy = InfoBMP.biHeight
ValSeuilR = Cells(1, 6)
ValSeuilV = Cells(1, 6)
ValSeuilB = Cells(1, 6)
LongueurLigne = (InfoBMP.biWidth * 3)
ReDim Image(LongueurLigne, InfoBMP.biHeight)
Do While Not EOF(1)
224
Kévin Beck (2006)