begin process at 2010 02 10 08:57:02
  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 226

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 ALBUM PHOTOS par ayoube2009
Source avec Zip Source avec une capture EDITEUR D'AUTOMATES CELLULAIRES par PADYVEN
Source avec Zip Source avec une capture PROGRAMME DE DESSIN À LA SOURIS AVEC OUVERTURE ET ENREGISTRE... par SnkVrt
Source avec Zip Source avec une capture Source .NET (Dotnet) PHOTOSEXPRESS - TRAITEMENT DE PHOTOS par zozo14
Source avec Zip Source avec une capture ÉCRIRE SUR LE WALLPAPER par Rafale71

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...

CalendriCode

Février 2010
LMMJVSD
1234567
891011121314
15161718192021
22232425262728

Consulter la suite du CalendriCode

 
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,452 sec (4)

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