COMPTER LES COULEURS D'UNE IMAGE
Caribensila
Messages postés
2527
Date d'inscription
jeudi 15 janvier 2004
Statut
Membre
Dernière intervention
16 octobre 2019
-
29 sept. 2012 à 20:07
f0xi Messages postés 4205 Date d'inscription samedi 16 octobre 2004 Statut Modérateur Dernière intervention 12 mars 2022 - 19 oct. 2012 à 14:31
f0xi Messages postés 4205 Date d'inscription samedi 16 octobre 2004 Statut Modérateur Dernière intervention 12 mars 2022 - 19 oct. 2012 à 14:31
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.
https://codes-sources.commentcamarche.net/source/54621-compter-les-couleurs-d-une-image
https://codes-sources.commentcamarche.net/source/54621-compter-les-couleurs-d-une-image
19 oct. 2012 à 14:31
type
TColorsCounters = array[0..3, 0..$FF] of word;
TExplodedColor = packed array[0..3] of byte;
TScanLine = array[0..0] of TExplodedColor;
PScanLine = ^TScanLine;
TImageInfo = packed record
RenderTime : LongWord;
Pixels : LongWord;
ShadesOfAlpha : LongWord;
ShadesOfRed : LongWord;
ShadesOfGreen : LongWord;
ShadesOfBlue : LongWord;
TotalShades : LongWord;
MainShade : byte;
function getFromBitmap(BMP: TBitmap): TImageInfo;
end;
function TImageInfo.getFromBitmap(BMP: TBitmap): TImageInfo;
var Y,X,T: integer;
P: PScanLine;
Counters : TColorsCounters;
C : TExplodedColor;
begin
FillChar(Counters, 4*256, 0);
FillChar(self, 7*4+1,0);
BMP.PixelFormat := pf32bit;
RenderTime := getTickCount;
Pixels := BMP.Width * BMP.Height;
for Y := 0 to BMP.Height-1 do
begin
P := BMP.ScanLine[Y];
for X := 0 to BMP.Width-1 do
begin
C := P^[X];
Counters[0, C[0]] := 1;
if C[0] = $00 then
begin
Counters[1, C[1]] := 1;
Counters[2, C[2]] := 1;
Counters[3, C[3]] := 1;
end;
end;
end;
for X := $01 to $ff do
begin
if Counters[3, X] = 1 then inc(ShadesOfAlpha);
if Counters[0, X] = 1 then inc(ShadesOfRed);
if Counters[1, X] = 1 then inc(ShadesOfGreen);
if Counters[2, X] = 1 then inc(ShadesOfBlue);
end;
TotalShades := (1+ShadesOfRed) * (1+ShadesOfGreen) * (1+ShadesOfBlue);
if (ShadesOfRed > ShadesOfGreen) and (ShadesOfRed > ShadesOfBlue) then
MainShade := 0;
if (ShadesOfGreen > ShadesOfRed) and (ShadesOfGreen > ShadesOfBlue) then
MainShade := 1;
if (ShadesOfBlue > ShadesOfGreen) and (ShadesOfBlue > ShadesOfRed) then
MainShade := 2;
RenderTime := getTickCount-RenderTime;
result := self;
end;
7 oct. 2012 à 17:12
sincère et désintéressé..
@barbichette :
des coquilles, en cherchant bien, il y en a dans les anciens codes
déposées (dans les miens surtout !)
la perfection à 100% n'est pas utile ici (sauf gros plantage bien sûr..)
l'essentiel n'est-il pas de montrer l'idée et chacun ensuite en fait ce qu'il veut..
6 oct. 2012 à 12:47
- LES CODES MARRANTS & INNOVANTS 100% INUTILES
5 oct. 2012 à 19:28
5 oct. 2012 à 19:26
Que de papotage pour une simple fonction de comptage.
Je vais finir par poster une fonction de calcul du PGCD...
Bon, je plaisante...
Je suis d'accord avec Cantador sur le fait que ce genre d'échange et toujours intéressant. Et c'est d'ailleurs le but de ce genre de site. Le partage.
Enfin, il me semble.
Même si bon nombre de nouveaux inscrits ne me semble pas que peu intéressants, il y en a surement un petit nombre qui ne demande qu'a s’épanouir, monter leurs talents et nous transmettre du sang neuf.
Car même si les les vieux de la vieille donnent l'impression d'avoir une science infuse, elle infuse surtout dans une eau bien claire...
Je pense qu'on peut apprendre à tout âge, la preuve avec la question de Caribensila sur les tableaux [0..0].
Je suis aussi d'accord sur le fait qu'il manque de nos jour un peu d'humour et de légèreté... Mais en vieillissant, on devient tous plus sage... C'est la loi de la nature.
Enfin, malgré tout ces blabla, personne n'a remarqué que ma source était fausse...
Je vais donc me dépêcher de la modifié car la recherche de la couleur la moins présente n'est pas du tout la bonne...
Comme quoi, même les vieux peuvent se tromper...
Barbichette
5 oct. 2012 à 15:00
5 oct. 2012 à 14:26
C'est important, car ceux-ci contribuent à pérenniser le site.
Beaucoup d'anciens sont partis, mais d'autres jeunes talents sont arrivés..
Caribensila fait parti des valeurs sures de ce site, grâce à son expérience élargie de la programmation delphi, l'originalité de ses programmes, de ses questions, de son écriture aussi et surtout son humour.
5 oct. 2012 à 11:13
je te propose de déposer cette source qui permettra de poursuivre cette discussion
sur le même thème et avec tous ceux intéressés..
et il y en a apparemment.
4 oct. 2012 à 22:17
J'ai déjà rencontré la fonction que tu cherches.
Je transforme une photo en image de bande dessinée en délimitant d'abord les contours de plages de couleur semblable (pas égale, semblable) puis à l'intérieur de chaque contour en réduisant le nombre de couleurs à l'une de ces couleurs semblables.
Je peux t'envoyer un exemple (deux fichiers JPG), passe moi ton mail.
Je peux rechercher cette fonction à l'intérieur du programme source et la documenter proprement. Alternativement si tu es pressé je peux t'envoyer toute la source.
4 oct. 2012 à 18:31
Qu' est-ce qu' elle m' a manqué cette fonction ...
J' ose pas, si? barbichette, serait t-il possible de faire une fonction qui réduit le nombre de couleurs à l' image (en regroupant par couleurs proches, le nombre de couleurs étant passé en paramètre par exemple)?
Merci en tout cas pour cette superbe démonstration.
4 oct. 2012 à 17:37
et d'ailleurs personne n'a bronché.
korgis, korgis, forte tête,
celui-là je le mets sur mes tablettes..
@bientôt et bon courage à tous et merci pour cette très belle étude réalisée
par Barbichette
4 oct. 2012 à 16:45
Que ne les avez-vous réitérées sur le forum ?
@Caribensila, une explication pertinente ici :
http://www.developpez.net/forums/d179402/environnements-developpement/delphi/explication-array-0-0-of-vs-array-of/
(pour ma part, je pense que les tableaux dynamiques ne sont pas apparus avant Delphi 4).
@fbaudoux, une approche ici :
http://www.efg2.com/Lab/Library/Delphi/Graphics/Color.htm
qui renvoie ici :
http://www.efg2.com/Lab/Library/Delphi/Graphics/AndreasFilsinger_ColorContrast.txt
(mais je trouve les 2 méthodes employées décevantes).
Et Cantador est tout à fait en droit de m'engueuler, car en répondant, je cautionne.
1 oct. 2012 à 23:27
question pertinente mais néanmoins
mieux vaut utiliser le forum..
id pour Caribensila pour son array[0..0]
merci
1 oct. 2012 à 11:35
Comment puis je au départ de la couleur x d'un fond d'écran déterminer une couleur y qui est fort visible sur cette couleur x ?
1 oct. 2012 à 11:23
Pour le canal Alpha, je dirais que tout dépend du contexte.
Si on veut compter le nombre de couleurs, il n'intervient pas, en effet. Mais si le canal Alpha est utilisé pour autre chose que l'AlphaBlending et qu'on veut compter le nombre de types de pixel différents, on pourra en tenir compte. Au fond en 32bits, c'est plus un canal "Reserved" qu'un canal "Alpha".
Cependant, dans ce cas ma méthode n'est plus applicable à cause de la taille du tableau.
En passant, si quelqu'un pouvait m'expliquer la nature profonde d'un array[0..0], ce serait sympa (je serais étonné que ce soit comparable à un tableau dynamique pour lequel on ne devrait pas allouer de mémoire...).
J'ai l'habitude d'utiliser des tableaux dynamiques car l'accès est plus rapide qu'en statiques, mais je n'ai jamais osé utiliser cette forme de tableau par ignorance. J'ai cependant remarqué qu'il est souvent utilisé dans le code de Delphi lui-même.
Alors, si on pouvait éclairer ma lanterne... :)
30 sept. 2012 à 21:21
je dirais juste qu'on ne devrait pas en tenir compte lors du comptage des couleurs ... une différence de transparence n'est pas une nuance de couleur (cf. le noir opaque et le noir transparent ainsi que les 254 autres nuances de transparence sont une seule et même couleur ... du noir)
enfin ce n'est que mon avis.
30 sept. 2012 à 21:11
@Cirec:
en effet, la déclaration d'un tableau de 256 cases et en utiliser des milliers n'est pas très orthodoxe.
Je corrigerais avec
type
PQuadArray = ^TQuadArray;
TQuadArray = array[0..0] of longint;
Ça marche aussi bien mais c'est plus dans la syntaxe "Delphi".
Ensuite pour les images avec une couche alpha, si on ne veux pas utiliser cette couche :
n:=ClasseCouleur(q[i],24,arbre); (les 8 derniers bits de poids forts ne seront pas décodés)
ou encore
n:=ClasseCouleur(q[i] and $FFFFFF,32,arbre); (les 8 derniers bits de poids forts seront décodés mais tous à 0)
Merci à tous les deux
30 sept. 2012 à 20:24
pour commencer ...
il n'y a pas de fuites de mémoire, tous les pointeurs créés sont libérés
rien que pour ça je dis bravo :D
coté code il y a un truc qui me turlupine !!!
tu déclares:
type
PQuadArray = ^TQuadArray;
TQuadArray = array[Byte] of longint;
donc un tableau de longueur 256 ([0..255]) et pourtant tu l'indexes bien au delà :
...
var
i:integer;
q:PQuadArray;
...
for i:=0 to bitmap.height*bitmap.Width-1 do
begin
if ClasseCouleur(q[i],32,arbre)=1 then inc(result);
end;
alors ça fonctionne mais normalement ça ne devrait pas!!!
Ensuite vos deux codes posent un problème avec une image 32bits ... une vraie avec canal alpha et tout et tout :D
le code de Barbichette trouve trop de couleurs ...
normal il tient compte du cana Alpha pour déterminer une couleur
ainsi un noir opaque et un noir transparent y sont comptés comme deux couleurs différentes
et celui de Caribensila nous insulte via un message du compilateur ...
ici nous avons les mêmes causes pour des effets différents ...
le tableau est déclaré correctement (SetLength(RGBArray,$1000000);) [0..$FFFFFF]
mais quand le bitmap contient des pixels avec un canal Alpha <> 0 on se retrouve
en dehors des limites du tableau et paf on se fait insulter :D:D:D
j'ai appliqué la correction sur le code de Caribensila .. le principe reste le même
effectuer une opération logique sur la couleur de façon à ne conserver que les bytes de couleurs et non le canal alpha (Color and $FFFFFF) :
function ColorsCount(bitmap:tbitmap): integer;
var tmpPF : TPixelFormat;
pPix : pInt;
RGBArray : array of Integer;
i : Integer;
begin
Result := 0;
tmpPF := bitmap.PixelFormat;
bitmap.PixelFormat := pf32bit;
SetLength(RGBArray,$1000000);
try
for i := 0 to High(RGBArray) do RGBArray[i] := 0;
pPix := bitmap.ScanLine[bitmap.height-1];
for i:=1 to bitmap.height*bitmap.Width do
begin
Inc(RGBArray[pPix^ and $FFFFFF]);
Inc(pPix);
end;
for i := 0 to High(RGBArray) do if RGBArray[i]<>0 then Inc(Result);
finally
Finalize(RGBArray);
bitmap.PixelFormat:=tmpPF;
end;
end;
au passage ceci ((pPix^ shl 3) shr 3) n'apporte pas grand chose
voir rien.
sinon j'ai rien à dire à part bravo et merci pour ce code
29 sept. 2012 à 20:07
Ta méthode est très intéressante pour sa rapidité et par le fait qu'elle économise les ressources.
Bravo !
Mais il existe une méthode encore plus rapide, inspirée du tri casier (presque 2 fois plus rapide que la tienne).
Je la donne pour mémoire car elle est vraiment très gourmande en ressources :
function ColorsCount(bitmap:tbitmap): integer;
var tmpPF : TPixelFormat;
pPix : pInt;
RGBArray : array of Integer;
i : Integer;
begin
Result := 0;
tmpPF := bitmap.PixelFormat;
bitmap.PixelFormat := pf32bit;
SetLength(RGBArray,$1000000);
try
for i := 0 to High(RGBArray) do RGBArray[i] := 0;
pPix := bitmap.ScanLine[bitmap.height-1];
for i:=1 to bitmap.height*bitmap.Width do begin
Inc(RGBArray[(pPix^ shl 3) shr 3]);
Inc(pPix);
end;
for i := 0 to High(RGBArray) do if RGBArray[i]<>0 then Inc(Result);
finally
Finalize(RGBArray);
bitmap.PixelFormat:=tmpPF;
end;
end;
Bon! C'est pour les gens très pressés... et ça n'enlève rien aux mérites de ton algo.
10/10