Comparer deux fichiers Bitmap
Hello, it's me again -- désolé.
Je ne voulais pas vous embêter si vite mais franchement, il y a des jours on se demande...
Suite à mes récents déboires avec des images transparentes qui ne devraient pas l'être, je me suis mis en tête de bricoler vite fait un petit outil pour comparer des fichiers.
En même temps je me proposais de tester l'astuce que m'a passée anapurna concernant Scanline, mais on verra ça après, parce que d'entrée ça part mal.
Est-ce que vous voyez un défaut à cet algo (le premier fichier est parfaitement bien chargé par ailleurs, ça, ça concerne le second fichier et la comparaison) ?
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
34
35
36
37
38
39
40
41
| procedure TForm1.Button2Click(Sender: TObject);
var
pic: TPicture;
p1,p2: pRGBQuad;
h,w: integer;
begin
if not opd.Execute then exit;
pic := TPicture.Create;
try
pic.LoadFromFile(opd.Filename); // chargement du fichier
imgDisplay.Picture.Bitmap.BeginUpdate;
// parcours vertical
// for h := 0 to imgDisplay.Picture.Bitmap.Canvas.Height-1 do begin
// for h := 0 to imgDisplay.Picture.Bitmap.Height-1 do begin
for h := 0 to imgDisplay.Height-1 do begin
// p1 := pRGBQuad(imgDisplay.Picture.Bitmap.ScanLine[h]);
// p2 := pRGBQuad(pic.Bitmap.Scanline[h]);
// dessus en attente que ça fonctionne dessous
p1 := pRGBQuad(imgDisplay.Picture.Bitmap.RawImage.GetLineStart(h));;// source
p2 := pRGBQuad(pic.Bitmap.RawImage.GetLineStart(h));// second fichier
// parcours horizontal
// for w := 0 to imgDisplay.Picture.Bitmap.Canvas.Width-1 do begin
// for w := 0 to imgDisplay.Picture.Bitmap.Width-1 do begin
for w := 0 to imgDisplay.Width-1 do begin
if pRGBQuad(p1[w]) <> pRGBQuad(p2[w]) then begin // test et action si différence
// 2 lignes pour voir la vie des choses
memo1.Lines.Add(inttostr(h)+' '+inttostr(w));// de 299 303 à 299 399 -- le fic de test fait 400 x 300
Application.ProcessMessages;
// obligé de mettre ces 4 lignes en commentaire sinon SIGSEGV en fin de boucle
{ p1[w].rgbBlue :=0;
p1[w].rgbGreen:=0;
p1[w].rgbRed :=255;
p1[w].rgbReserved:=255; }
end; // test
end; // for w
end; // for h
imgDisplay.Picture.Bitmap.EndUpdate;
finally
pic.Free;
end;
end; |
Vous noterez que j'ai fait trois tentatives de balayage, avec toujours le même résultat, SIGSEGV :aie:
Et maintenant le truc qui tue, indépendamment de l'AV en fin de boucle : pour tester, avant de m'embarquer avec des fichiers dont je ne sais pas où sont les différences et s'il y en a, je teste en ouvrant deux fois le même fichier, et j'ai des lignes logguées dans le mémo !
Mais comment c'est possible un cauchemar pareil ? :cry: :cry: :cry:
Ah, tiens, si quelqu'un veut essayer rapidement, un TOpenPictureDialog, un TImage alClient dans un TPanel avec Color à clWhite et ça roule :
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
| procedure TForm1.OpenImage(Filename: string);
var
pic: TPicture;
begin
pic := TPicture.Create;
pic.Bitmap.Transparent:=False;
try
pic.LoadFromFile(Filename);
if (pic.Width <> pnl4img.Width) or (pic.Height <> pnl4img.Height) then begin
pnl4img.Width := pic.Width;
pnl4img.Height := pic.Height;
end;
imgDisplay.Picture.Assign(pic);
finally
pic.Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if opd.Execute then OpenImage(opd.FileName);
Button2.SetFocus;
end; |
1 pièce(s) jointe(s)
Rions un peu avec la propriété Transparent du TImage
Bonjour,
j'avais dit qu'il n'y aurait plus de code, et pour le moment je tiens parole, :P
EDIT : quoique...
pour une utilisation (qui a parlé d'expérience :massacre:, comme un peu partout depuis quelque temps ?) encore plus confortable, rajoutez-vous une ligne tout à la fin de la proc de drag'n'drop, comme ça :
Code:
1
2
3
4
5
| procedure TMainForm.FormDropFiles(Sender: TObject;
...
btnOpenClick(nil);
MainForm.BringToFront; // <-- pour que la fenêtre se réaffiche par-dessus l'explorateur après le drop
end; |
/EDIT
Je fais du ménage dans mes vieux fichiers, je retrouve ce joli dégradé et une intuition me pousse à le drag'n'droper (que du bonheur ce truc !) dans mon nouvel outil, et bien m'en a pris :
Pièce jointe 285835
Alors cette fois c'est le rouge (à gauche toute, 255 0 0) qui marque la couleur de la transparence, mais d'où le TImage sort-il cette information ?
Car si sans fermer le prog je lui drag-n-drope le 200x150x24_T, cette fois c'est le gris 84 84 84 qui devient la couleur de la transparence.
C'est enregistré dans les fichiers ? Où ?
Je rappelle que ces deux fichiers sont en pf24bit, et qu'il n'y a donc aucune info de transparence dans le TBitmapInfoHeader...
J'ai fouillé dans d'autres fichiers, et j'ai découvert un Rouge pas franc (255 17 77), un gris 169 169 169, un bleu 127 255 255, bref, ça a l'air aléatoire mais, j'y pense tout d'un coup, on dirait que ça part toujours d'en bas à gauche...
J'ai fait un test avec une image de carrés colorés dont celui en bas à gauche était bleu et transparent en activant la case : je l'ai édité pour remplacer ce bleu par du jaune, il y avait un autre carré jaune ailleurs, et maintenant les deux deviennent transparents en fonction de l'état de la case à cocher.
Voilà.
C'est une info qu'on a tendance à oublier : si on active la transparence du TImage, celui-ci détermine la couleur transparente en se basant sur celle du pixel en bas à gauche, si on ne précise pas TransparentColor := ...;.
Difficile à détecter avec les images de test 400x300 "Lena" car le pixel en question est... blanc ! Et blanc ou rien_sur_fond_blanc c'est un peu pareil, :D
:coucou:
