begin process at 2012 02 14 03:29:31
  Trouver un code source :
 
dans
 
Accueil > 

Code

 > 

Graphique

 > 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

Note :
7,71 / 10 - par 7 personnes
7,71 / 10

  • 1

  • 2

  • 3

  • 4

  • 5

  • 6

  • 7

  • 8

  • 9

  • 10
Catégorie :Graphique Niveau :Expert Date de création :27/02/2002 Date de mise à jour :27/02/2002 10:32:43 Vu :2 769

Auteur : Cirtasoft

Ecrire un message privé
Ce membre participe au partage de revenus publicitaires
Commentaire sur cette source (8)
Ajouter un commentaire et/ou une note


 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

TEXTBOX NUMERIQUE AVEC DES API
Source avec Zip CRÉATION DES METAFILE IMAGE SUR VB (DEMO+COM+SOURCE DE DLL E...
Source avec Zip Source avec une capture SHELLLISTVIEW LE CONTOL ACTIVEX
Source avec Zip Source avec une capture MY PROJECT APPLICATION (GESTION DES PROJETS VB) AVEC STYLE W...
Source avec Zip Source avec une capture CIRTASOFT IMAGO 2002 (IL Y A QUE LE CODE-SOURCE)

 Sources de la même categorie

Source avec Zip Source avec une capture Source .NET (Dotnet) CREER UN GIF ANIMÉ par Le Pivert
Source avec une capture GRAPH PHP COURBE DE CHARGE par s.defaye
Source avec Zip Source avec une capture BOULE DE CRISTAL par BLUEBIBUBBLE
VB6 - DÉPLACEMENT D'UN CONTRÔLE SUR UN SEGMENT DE DROITE DÉL... par ucfoutu
Source avec Zip Source .NET (Dotnet) APPLICATION DE DESSIN par fsafsafsaf

Commentaires et avis

Commentaire de celiphane le 27/02/2002 12:27:39

heu, g po essayé mais, c pas un peu nul ?

pour remplacer un pixel par un autre dans une picture box je fais simplement ça :
(pour la picture box nommée "picture1")

Picture1.PSet (X, Y), RGB(R, V, B)

où X,Y sont les coordonnés du point, et R V B respectivement le dosage des couleurs Rouge Vert et Bleu pour ce pixel...

voilà, en une ligne... arf

Bon ba bon courage qd mm si t'aime bien te compliquer...

Ha oui : où c'est que t'a été repiqué ce code ? Ta remarqué en haut de la page ? ya noté "Auteur :"...
les comments sont en anglais, ça se voit bien...       ;O) piti malin

Commentaire de Scooby1 le 11/10/2002 11:58:13

ça ne fonctionne pas. Explique.

Commentaire de patrick le 11/10/2002 14:28:49

Le code "originel" vient de l'API Guide :

    'KPD-Team 1999
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net

Pour répondre à Scooby1,  il semble que cela ne fonctionne qu'avec des images BMP sauvegarder en 24 Bit (RGB)

Commentaire de patrick le 11/10/2002 14:29:37

Le code "originel" vient de l'API Guide :

    'KPD-Team 1999
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net

Pour répondre à Scooby1,  il semble que cela ne fonctionne qu'avec des images BMP sauvegardées en 24 Bit (RGB)

Commentaire de Anthomicro le 03/11/2002 08:37:46

Salut tout le monde !
ça marche impec et en plus c'est super rapide !
Et un truc en plus pour mon prog de desssin, un !
Un petit 10 pour remonter cette moyenne
:-)

Commentaire de NicolleauElise le 19/11/2002 15:28:25

et un ptit 1 pour baisser cette moyenne ! {:)

Commentaire de logisim le 22/03/2003 19:38:23

Super ! Mais ça ne serait pas plus simple d'utiliser l'API SetBkColor ?

Commentaire de muelsaco le 03/03/2005 16:06:56

Exellent, si vous comprenez pas que c'est 1000 fois plus rapide que pset et getpxl, je peux rien pour vous...
En tout cas çà mérite 10 !
Pour info la source sur http://www.allapi.net/ est bien plus clair.

 Ajouter un commentaire




Nos sponsors


Sondage...

Comparez les prix

CalendriCode

Février 2012
LMMJVSD
  12345
6789101112
13141516171819
20212223242526
272829    

Consulter la suite du CalendriCode

Photothèque

 
Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils.
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés

Google Coop CodeS-SourceS Google Coop CodeS-SourceS
Temps d'éxécution de la page : 0,702 sec (4)

Nous contacter | Annoncer sur CodeS-SourceS | Mentions légales