zwarul
Messages postés35Date d'inscriptionvendredi 4 février 2005StatutMembreDernière intervention 3 août 2008
-
5 août 2005 à 16:45
Gobillot
Messages postés3140Date d'inscriptionvendredi 14 mai 2004StatutMembreDernière intervention11 mars 2019
-
6 août 2005 à 15:55
bon voila je cherche une fonction, ou un code, qui me permette de ne conserver dans une image que les pixels qui sont d'une couleur précise (dans mon cas précis les pixels de couleur r:0 v:44 b:128), et que tout les pixels qui ne sont pas de cette couleur deviennent blanc par exemple, ou d'une autre couleur que je puisse choisir....
si vous savez aidez moi sivouplé!!!!!!!!!!!!!!!!!
ps: (si vous avez une fonction ou un code particulièrement rapide je suis trés trés preneur)
A voir également:
Effacer tout les pixels qui ne sont pas de la couleur "x" dans une image bmp????
Gobillot
Messages postés3140Date d'inscriptionvendredi 14 mai 2004StatutMembreDernière intervention11 mars 201934 5 août 2005 à 18:07
Option Explicit
Const BI_RGB = 0&
Const DIB_RGB_COLORS = 0
Private Type BITMAPINFOHEADER
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type
Private Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type
Private Type BITMAPINFO
bmiHeader As BITMAPINFOHEADER
bmiColors As RGBQUAD
End Type
Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long,
ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As
Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function SetDIBits Lib "gdi32" (ByVal hdc As Long,
ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As
Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
zwarul
Messages postés35Date d'inscriptionvendredi 4 février 2005StatutMembreDernière intervention 3 août 2008 6 août 2005 à 14:08
bon c'est nikel les deux codes font ce que je voulai j'ai juste du modifier ça:
Option Explicit
Const BI_RGB = 0&
Const DIB_RGB_COLORS = 0
Private Type BITMAPINFOHEADER
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type
Private Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type
Private Type BITMAPINFO
bmiHeader As BITMAPINFOHEADER
bmiColors As RGBQUAD
End Type
Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function SetDIBits Lib "gdi32" (ByVal hdc As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Sub Command1_Click()
Dim bitmap As BITMAPINFO
Dim pixels() As Byte
Dim x As Integer
Dim y As Integer
Dim bw As Long
Dim bh As Long
With bitmap.bmiHeader
.biSize = 40
.biWidth = bw
.biHeight = -bh
.biPlanes = 1
.biBitCount = 32
.biCompression = BI_RGB
End With
ReDim pixels(1 To 4, 1 To bw, 1 To bh)
GetDIBits Picture1.hdc, Picture1.Image, 0, bh, pixels(1, 1, 1), bitmap, DIB_RGB_COLORS
For y = 1 To bh
For x = 1 To bw If pixels(1, x, y) 0 And pixels(2, x, y) 44 And pixels(3, x, y) = 128 Then
pixels(1, x, y) < > 255: pixels(2, x, y) < > 255: pixels(3, x, y) < > 255
End If
Next
Next
Dim Bh As Integer, Bw As Integer
Bh = pic1.ScaleHeight
Bw = pic1.ScaleWidth
Dim iX As Integer, iY As Integer
For iX = 0 To Bw
For iY = 0 To Bh
If pic1.Point(iX, iY) <> SearchColor Then pic1.PSet (iX, iY), RemplaceColor
Next iY
Next iX