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