Accueil > > > REMPLACER UNE COULEUR DANS UNE PICTURE PAR UNE OUTRE COULEUR VITE
REMPLACER UNE COULEUR DANS UNE PICTURE PAR UNE OUTRE COULEUR VITE
Information sur la source
Description
Choise une couleur dans une Picture et Remplacer par une outre couleur.
Source
- Private Type BITMAP
- bmType As Long
- bmWidth As Long
- bmHeight As Long
- bmWidthBytes As Long
- bmPlanes As Integer
- bmBitsPixel As Integer
- bmBits As Long
- End Type
- Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
- Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
- Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
- Dim PicBits() As Byte, PicInfo As BITMAP
- Dim Cnt As Long, BytesPerLine As Long
- Private Sub ChangeColor(Pic As PictureBox, RemoveColor As Long, NewColor As Long)
- 'Get information (such as height and width) about the picturebox
- GetObject Pic.Picture, Len(PicInfo), PicInfo
- 'reallocate storage space
- BytesPerLine = (PicInfo.bmWidth * 3 + 3) And &HFFFFFFFC
- ReDim PicBits(1 To BytesPerLine * PicInfo.bmHeight * 3) As Byte
-
- 'Copy the bitmapbits to the array
- GetBitmapBits Pic.Picture, UBound(PicBits), PicBits(1)
- 'Invert the bits
- CouleurRGB NewColor, mrd, mvd, mbd
- For Cnt = 1 To UBound(PicBits) Step 3
- If RGB(PicBits(Cnt), PicBits(Cnt + 1), PicBits(Cnt + 2)) = RemoveColor Then
- PicBits(Cnt) = mbd: PicBits(Cnt + 1) = mvd: PicBits(Cnt + 2) = mrd
- End If
- Next Cnt
- 'Set the bits back to the picture
- SetBitmapBits Pic.Picture, UBound(PicBits), PicBits(1)
- 'refresh
- Pic.Refresh
- End Sub
-
- Function CouleurRGB(ValeurColor, rd, vd, bd) As Long
- ValeurC = ValeurColor
- Dim r As Long: Dim v As Long: Dim b As Long: Dim Couleur1: Dim Couleur2: Couleur1 = ValeurC: Couleur2 = Couleur1: bd = ((((Couleur2 \ &H10000) And &HFF) * 50) + (((Couleur1 \ &H10000) And &HFF) * 50)) \ 100: vd = ((((Couleur2 \ &H100) And &HFF) * 50) + (((Couleur1 \ &H100) And &HFF) * 50)) \ 100: rd = (((Couleur2 And &HFF) * 50) + ((Couleur1 And &HFF) * 50)) \ 100: CouleurEff = RGB(rd, vd, bd) 'pour avoir la couleur directement !
- End Function
Private Type BITMAP
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Dim PicBits() As Byte, PicInfo As BITMAP
Dim Cnt As Long, BytesPerLine As Long
Private Sub ChangeColor(Pic As PictureBox, RemoveColor As Long, NewColor As Long)
'Get information (such as height and width) about the picturebox
GetObject Pic.Picture, Len(PicInfo), PicInfo
'reallocate storage space
BytesPerLine = (PicInfo.bmWidth * 3 + 3) And &HFFFFFFFC
ReDim PicBits(1 To BytesPerLine * PicInfo.bmHeight * 3) As Byte
'Copy the bitmapbits to the array
GetBitmapBits Pic.Picture, UBound(PicBits), PicBits(1)
'Invert the bits
CouleurRGB NewColor, mrd, mvd, mbd
For Cnt = 1 To UBound(PicBits) Step 3
If RGB(PicBits(Cnt), PicBits(Cnt + 1), PicBits(Cnt + 2)) = RemoveColor Then
PicBits(Cnt) = mbd: PicBits(Cnt + 1) = mvd: PicBits(Cnt + 2) = mrd
End If
Next Cnt
'Set the bits back to the picture
SetBitmapBits Pic.Picture, UBound(PicBits), PicBits(1)
'refresh
Pic.Refresh
End Sub
Function CouleurRGB(ValeurColor, rd, vd, bd) As Long
ValeurC = ValeurColor
Dim r As Long: Dim v As Long: Dim b As Long: Dim Couleur1: Dim Couleur2: Couleur1 = ValeurC: Couleur2 = Couleur1: bd = ((((Couleur2 \ &H10000) And &HFF) * 50) + (((Couleur1 \ &H10000) And &HFF) * 50)) \ 100: vd = ((((Couleur2 \ &H100) And &HFF) * 50) + (((Couleur1 \ &H100) And &HFF) * 50)) \ 100: rd = (((Couleur2 And &HFF) * 50) + ((Couleur1 And &HFF) * 50)) \ 100: CouleurEff = RGB(rd, vd, bd) 'pour avoir la couleur directement !
End Function
Sources du même auteur
Sources de la même categorie
Commentaires et avis
|
Derniers Blogs
XNA IS DEAD!XNA IS DEAD! par richardc
Depuis la semaine dernière (et grâce aux TechDays 2012), je me penche activement sur la nouvelle version de Windows, aka Windows 8. Vous me direz, il était temps puisque la première preview date de Septembre dernier.
OK. Remarquez, on n'en est qu'aux...
Cliquez pour lire la suite de l'article par richardc TECHDAYS PARIS 2012 : WINDOWS SERVER "8" QUOI DE 9 !TECHDAYS PARIS 2012 : WINDOWS SERVER "8" QUOI DE 9 ! par ROMELARD Fabrice
Speakers: Fabrice Meillon et Stanislas Quastana Cette session est basée entièrement sur celle donnée lors de la BUILD cet hiver. Il n'y a pas d'ajout d'information en rapport avec cet évènement passé. Windows 8 Server sera intégralem...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice [HTML5] AUTOUR DU W3C : NOUVEAUX STANDARDS ET WEB MOBILE (LILLE)[HTML5] AUTOUR DU W3C : NOUVEAUX STANDARDS ET WEB MOBILE (LILLE) par Gio
Je m'y prends un peu tard je sais, mais bon je suis développeur web et donc hyper fainéant ! Toujours dans le cadre des technologies émergentes, ici HTML5, parce qu'on aime HTML5 chez Wyg , nous seront présent, le vieux ( Aurélien V.) et moi, pour pr...
Cliquez pour lire la suite de l'article par Gio [WP7] DYNAMICALLY CHANGE STARTUP PAGE[WP7] DYNAMICALLY CHANGE STARTUP PAGE par KooKiz
Let's say that you want to allow the user to customize the startup page of your application. You can easily change the startup page by editing the 'NavigationPage' attribute in the manifest file. But the manifest cannot be modified once the applicatio...
Cliquez pour lire la suite de l'article par KooKiz
Logiciels
DocTranslate (V3.1.0.0)DOCTRANSLATE (V3.1.0.0)DocTranslate est un traducteur de document Microsoft Word, PowerPoint et Excel. Il permet d'autom... Cliquez pour télécharger DocTranslate Tribler (2012)TRIBLER (2012)Tribler est un client pair à pair (P2P/Peer-to-Peer) open source avec la capacité de regarder des... Cliquez pour télécharger Tribler OneSwarm (2012)ONESWARM (2012)Le peer-to-peer qui protège votre vie privée, c'est OneSwarm.
Ce logiciel de peer-to-peer crypté... Cliquez pour télécharger OneSwarm PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA TV DEVIENS HELLLOOO FLASH
LA TV SUR VOTRE ORDINATEUR.
Toute une plateforme Multi... Cliquez pour télécharger PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO Academy System (17.2.1.0)ACADEMY SYSTEM (17.2.1.0)Logiciel de gestion des établissements.
- élèves/étudiants (inscription, dossier, absence...)
-... Cliquez pour télécharger Academy System
|