Problème de modification d'un PNG avec GetLineStart

Version imprimable

Bonjour,

J'utilise "doParallel" pour modifier les couleurs traitées dans un GetLineStart.
Voici les deux routines qui me servent à contrôler et modifier mes couleurs. Quand je sauvegarde mon PNG puis que je vérifie, les modifications n’ont pas été prise en compte.
Mon code étant relativement simple, j'avoue que je ne comprends pas ce qui bloque.

Auriez-vous une idée ?
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 procedure TForm1.Button1Click(Sender: TObject); begin ProcThreadPool.DoParallel(@CompterPixelsLigne, 0, fPNG.Height - 1, fPNG); fPNG.SaveToFile(FICHIER_DE_COPIE); Image1.Picture.Assign(fPNG); end; procedure TForm1.CompterPixelsLigne(Index: PtrInt; Data: Pointer; Item: TMultiThreadProcItem); var X: DWord; L : PInteger; P: integer; S: string; begin L := Pinteger(TPortableNetworkGraphic(Data).RawImage.GetLineStart(Index)); P := L^; inc(L); For X := 1 to TPortableNetworkGraphic(Data).Width - 1 do begin S := Format('$%.6x', [(L^ and $FFFFFF)]); if NOT AnsiMatchText(S, Refcolors) then L^:= P; P := L^; inc(L); end; end;

Yop !

Sous toute réserve :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
 
procedure TForm1.CompterPixelsLigne(Index: PtrInt; Data: Pointer; Item: TMultiThreadProcItem);
var
  X: DWord;
  L : PInteger;
  P: integer;
  S: string;
begin
  TPortableNetworkGraphic(Data).BeginUpdate; // <<<<<
  L := Pinteger(TPortableNetworkGraphic(Data).RawImage.GetLineStart(Index));
 
  P := L^;
  inc(L);
 
  For X := 1 to TPortableNetworkGraphic(Data).Width - 1 do
  begin
    S := Format('$%.6x', [(L^ and $FFFFFF)]);
 
    if NOT AnsiMatchText(S, Refcolors) then
      L^:= P;
 
    P := L^;
    inc(L);
  end;
  TPortableNetworkGraphic(Data).EndUpdate; // <<<<<
end;

04/12/2019, 16h00
BeanzMaster

Salut

Petit question pourquoi te servir de TPortableNetworkGraphic ? et pas de TBitmap directement ? ensuite pourquoi ne pas tenir compte du premier pixel ? car si il est identique à RefColor il ne sera jamais modifié. RefColor tu le définis ou et comment ?
Est ce que le TImage affiche bien tes modifications ?
Ensuite attention le PNG accepte la transparence (32 bits) donc est ce que le pixel format est bien en 24 bits dans ton cas. Car sinon il faut définir P également comme cela P := (L^ and $FFFFFF)
Pourrais tu nous faire juste un petit projet reproduisant ce problème que l'on puisse jeter un oeil, si jamais ?

A+
Jérôme
04/12/2019, 16h06
der§en

Merci, j'ai bêtement oublie cette option :mrgreen:
04/12/2019, 16h24
Jipété

Citation:

Envoyé par der§en

Merci, j'ai bêtement oublié cette option :mrgreen:

Quelle option ? Ma réponse ou celle de Jérôme :koi:
04/12/2019, 16h42
der§en

Citation:

Envoyé par BeanzMaster

Salut

Petit question pourquoi te servir de TPortableNetworkGraphic ? et pas de TBitmap directement ? ensuite pourquoi ne pas tenir compte du premier pixel ? car si il est identique à RefColor il ne sera jamais modifié. RefColor tu le définis ou et comment ?
Est ce que le TImage affiche bien tes modifications ?
Ensuite attention le PNG accepte la transparence (32 bits) donc est ce que le pixel format est bien en 24 bits dans ton cas. Car sinon il faut définir P également comme cela P := (L^ and $FFFFFF)
Pourrais tu nous faire juste un petit projet reproduisant ce problème que l'on puisse jeter un oeil, si jamais ?

A+
Jérôme

Je me sers de TPortableNetworkGraphic car mon image source est un PNG.

Ensuite ma routine est là pour remplacer les couleurs qui ne font pas partie de ma liste ; en procédant ainsi, j'élimine toutes les couleurs indésirables.

Je ne l'ai pas mis, mais je finalise mon contrôle par ligne en vérifiant le premier pixel aussi. :mrgreen:
Le TImage affiche bien mes modifications car dès que je relance le comptage des couleurs, je passe bien de 1456 à mes 24 couleurs attendues. :yaisse1:
04/12/2019, 16h43
der§en

Citation:

Envoyé par Jipété

Quelle option ? Ma réponse ou celle de Jérôme :koi:

A toi :ccool:
04/12/2019, 16h51
der§en

Par contre, je constate un truc agaçant, c'est que mon image en sortie passe de 32 à 24 bits, alors même que bien forcée à pf32bit. :aie:

@der§en,

Là aussi tu peux te passer de cette conversion en string (l'idéal serait que Refcolors soit un entier).

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
procedure TForm1.CompterPixelsLigne(Index: PtrInt; Data: Pointer; Item: TMultiThreadProcItem);
var
  ...
  RefC :integer;
begin
  ...
  RefC := StrToInt(Refcolors);
 
  For X := 1 to TPortableNetworkGraphic(Data).Width - 1 do
  begin
    if (L^ and $FFFFFF) <> RefC 
    then L^:= P
    else P := L^;
 
    inc(L);
  end;
end;

[/QUOTE]

04/12/2019, 19h18
Jipété

Citation:

Envoyé par der§en

Par contre, je constate un truc agaçant, c'est que mon image en sortie passe de 32 à 24 bits, alors même que bien forcé à pf32bit :aie:

Ah ça, c'est un b0rd3l infâme dans Lazarus/FreePascal, on en a souvent causé avec Jérôme, faut faire avec…
04/12/2019, 19h19
der§en

RefColors est une array contenant ma liste de mes 24 couleurs de référence.
04/12/2019, 19h20
der§en

Citation:

Envoyé par Jipété

Ah ça, c'est un b0rd3l infâme dans Lazarus/FreePascal, on en a souvent causé avec Jérôme, faut faire avec…

Existe-t’il une solution ?
04/12/2019, 19h36
BeanzMaster

Citation:

Envoyé par der§en

Existe-t’il une solution ?

Pour l'explication de ce changement c'est que ton image n'a aucun pixel avec de la transparence. Pour la solution c'est de passer par TLazIntfImage, mais c'est un peu galère quand même
04/12/2019, 19h42
Jipété

Citation:

Envoyé par der§en

Existe-t’il une solution ?

Sous-entendu "simple" ? Pas à ma connaissance. Ça dépend entre autres de la version du BITMAPINFOHEADER (1, 4, 5), il faut donc ouvrir le fichier en mode "lisons donc les données du début du fichier et allons à la pêche aux datas" et après il faudra jouer avec le TLazIntfImage ou pas.

Si tu sais te servir du moteur de recherche du forum, cherche avec mon pseudo et ces mots-clé, tape-toi les discussions avec Jérôme, munis-toi de fichiers bitmap de différentes versions, passe à la pharmacie et dévalise leur stock d'aspirine, et bon courage…