Fórum Problemas ao comparar imagens no delphi 7 #564304
19/10/2016
0
Ola a todos, auguem por favor poderia me esclarecer o ocorrido pois estou usando o seguinte codigo:
function semelhanca(tol: byte; img1, img2: TImage): real;
type
TRGB32 = packed record
B, G, R, A: Byte;
end;
TRGB32Array = packed array[0..MaxInt div SizeOf(TRGB32)-1] of TRGB32;
PRGB32Array = ^TRGB32Array;
var
x, y: Integer;
TolOk: boolean;
cnt: longint;
abmp: Tbitmap;
linha1,linha2 : PRGB32Array;
begin
cnt := 0;
{ cria abmp na memoria }
abmp := Tbitmap.Create;
{ para caso a imagem no img1 não seja do tipo bmp que seja feita a conversão }
{ converte a imagem em img1 em bmp e depois devolve para img1 }
abmp.Width := img1.Width;
abmp.Height := img1.Height;
abmp.Assign(img1.Picture.Graphic);
img1.Picture.Bitmap.Assign(abmp);
{ para caso a imagem no img2 não seja do tipo bmp que seja feita a conversão }
{ converte a imagem em img2 em bmp e depois devolve para img2 }
abmp.Width := img2.Width;
abmp.Height := img2.Height;
abmp.Assign(img2.Picture.Graphic);
img2.Picture.Bitmap.Assign(abmp);
{ liberta abmp da memoria }
abmp.Free;
{loop de compração}
for y := 0 to img1.Height - 1 do
begin
linha1:=img1.Picture.Bitmap.ScanLine[y];// busca uma linha em img1
linha2:=img2.Picture.Bitmap.ScanLine[y];// busca uma linha em img2
for x := 0 to img1.Width - 1 do
begin
TolOk := true;
if TolOk then TolOk := abs(linha1[x].R-linha2[x].R)<tol; // se verdadeiro tem pigmento vermelho com tolerancia desejada
if TolOk then TolOk := abs(linha1[x].G-linha2[x].G)<tol; // se verdadeiro tem pigmento verde com tolerancia desejada
if TolOk then TolOk := abs(linha1[x].B-linha2[x].B)<tol; // se verdadeiro tem pigmento azul com tolerancia desejada
if TolOk then inc(cnt); // se verdadeiro soma +1 como sendo os pixels em img1[x,y] e img2[x,y] sendo semelhente
end;
result := cnt / (img1.Height * img1.Width) * 100; // retorna quanto % as imagem são semelhante
end;
Estou comparando 2 imagens de mesmo tamanho, mas quando uso imagens abaixo de 52x52 da um erro "Scan Line index out of range" e não sei como resolver, preciso comparar imagens de 20x20 até 70x70 sendo que sempre uso 2 de mesmo tamanho para comparar.
function semelhanca(tol: byte; img1, img2: TImage): real;
type
TRGB32 = packed record
B, G, R, A: Byte;
end;
TRGB32Array = packed array[0..MaxInt div SizeOf(TRGB32)-1] of TRGB32;
PRGB32Array = ^TRGB32Array;
var
x, y: Integer;
TolOk: boolean;
cnt: longint;
abmp: Tbitmap;
linha1,linha2 : PRGB32Array;
begin
cnt := 0;
{ cria abmp na memoria }
abmp := Tbitmap.Create;
{ para caso a imagem no img1 não seja do tipo bmp que seja feita a conversão }
{ converte a imagem em img1 em bmp e depois devolve para img1 }
abmp.Width := img1.Width;
abmp.Height := img1.Height;
abmp.Assign(img1.Picture.Graphic);
img1.Picture.Bitmap.Assign(abmp);
{ para caso a imagem no img2 não seja do tipo bmp que seja feita a conversão }
{ converte a imagem em img2 em bmp e depois devolve para img2 }
abmp.Width := img2.Width;
abmp.Height := img2.Height;
abmp.Assign(img2.Picture.Graphic);
img2.Picture.Bitmap.Assign(abmp);
{ liberta abmp da memoria }
abmp.Free;
{loop de compração}
for y := 0 to img1.Height - 1 do
begin
linha1:=img1.Picture.Bitmap.ScanLine[y];// busca uma linha em img1
linha2:=img2.Picture.Bitmap.ScanLine[y];// busca uma linha em img2
for x := 0 to img1.Width - 1 do
begin
TolOk := true;
if TolOk then TolOk := abs(linha1[x].R-linha2[x].R)<tol; // se verdadeiro tem pigmento vermelho com tolerancia desejada
if TolOk then TolOk := abs(linha1[x].G-linha2[x].G)<tol; // se verdadeiro tem pigmento verde com tolerancia desejada
if TolOk then TolOk := abs(linha1[x].B-linha2[x].B)<tol; // se verdadeiro tem pigmento azul com tolerancia desejada
if TolOk then inc(cnt); // se verdadeiro soma +1 como sendo os pixels em img1[x,y] e img2[x,y] sendo semelhente
end;
result := cnt / (img1.Height * img1.Width) * 100; // retorna quanto % as imagem são semelhante
end;
Estou comparando 2 imagens de mesmo tamanho, mas quando uso imagens abaixo de 52x52 da um erro "Scan Line index out of range" e não sei como resolver, preciso comparar imagens de 20x20 até 70x70 sendo que sempre uso 2 de mesmo tamanho para comparar.
Devair Loli
Curtir tópico
+ 0
Responder
Post mais votado
19/10/2016
Olá Devair, isso acontece porque o canvas (área livre para imagem) da imagem e o canvas do componente TImage não são iguais.
Você está pegando o canvas do TImage mas a imagem pode ter um canvas maior ou maior.
Assim, ou você habilita a propriedade autosize:=true para permitir que o TImage sempre tenha o mesmo tamanho da imagem, ou você faz com que a imagem convertida em bitmap fique no centro e complemente o canvas dela para ficar do mesmo tamanho do canvas do TImage ou simplesmente use img1.Picture.Bitmap.Height ao invés de imag1.Heigth
Outra coisa. pode não ser nada haver mas no seu código tinha um end a menos porque você abriu dois "for" e fechou com um "end" só.
Espero ter ajudado. Se fui útil, peço que marque um joinha para eu saber. Obrigado.
Você está pegando o canvas do TImage mas a imagem pode ter um canvas maior ou maior.
Assim, ou você habilita a propriedade autosize:=true para permitir que o TImage sempre tenha o mesmo tamanho da imagem, ou você faz com que a imagem convertida em bitmap fique no centro e complemente o canvas dela para ficar do mesmo tamanho do canvas do TImage ou simplesmente use img1.Picture.Bitmap.Height ao invés de imag1.Heigth
Outra coisa. pode não ser nada haver mas no seu código tinha um end a menos porque você abriu dois "for" e fechou com um "end" só.
Espero ter ajudado. Se fui útil, peço que marque um joinha para eu saber. Obrigado.
Hélio Devmedia
Responder
Gostei + 1
Mais Posts
19/10/2016
Hélio Devmedia
Eu enviei a resposta para a outra pergunta identica a esta. Verifique se resolveu o problema. Se sim, então marque um joinha para eu saber.
Responder
Gostei + 0
21/10/2016
Devair Loli
Autosize:=true; Resolveu perfeitamente o problema!
SEGUE CODIGO FUNCIONANDO:
function semelhanca(tol: byte; img1, img2: TImage): real;
type
TRGB32 = packed record
B, G, R, A: Byte;
end;
TRGB32Array = packed array[0..MaxInt div SizeOf(TRGB32)-1] of TRGB32;
PRGB32Array = ^TRGB32Array;
var
x, y: Integer;
TolOk: boolean;
cnt: longint;
abmp: Tbitmap;
linha1,linha2 : PRGB32Array;
begin
cnt := 0;
{ cria abmp na memoria }
abmp := Tbitmap.Create;
{ para caso a imagem no img1 não seja do tipo bmp que seja feita a conversão }
{ converte a imagem em img1 em bmp e depois devolve para img1 }
abmp.Width := img1.Picture.Bitmap.Width; //CORREÇÕES
abmp.Height := img1.Picture.Bitmap.Height; //CORREÇÕES
abmp.pixelformat := pf24bit;
abmp.Assign(img1.Picture.Graphic);
img1.AutoSize:=true; //CORREÇÕES
img1.Picture.Bitmap.Assign(abmp);
{ para caso a imagem no img2 não seja do tipo bmp que seja feita a conversão }
{ converte a imagem em img2 em bmp e depois devolve para img2 }
abmp.Width := img2.Picture.Bitmap.Width; //CORREÇÕES
abmp.Height := img2.Picture.Bitmap.Height; //CORREÇÕES
abmp.pixelformat := pf24bit;
abmp.Assign(img2.Picture.Graphic);
img2.AutoSize:=true; //CORREÇÕES
img2.Picture.Bitmap.Assign(abmp);
{ liberta abmp da memoria }
abmp.Free;
{loop de compração}
for y := 0 to img1.Height - 1 do
begin
linha1:=img1.Picture.Bitmap.ScanLine[y];// busca uma linha em img1
linha2:=img2.Picture.Bitmap.ScanLine[y];// busca uma linha em img2
for x := 0 to img1.Width - 1 do
begin
TolOk := true;
if TolOk then TolOk := abs(linha1[x].R-linha2[x].R)<tol; // se verdadeiro tem pigmento vermelho com tolerancia desejada
if TolOk then TolOk := abs(linha1[x].G-linha2[x].G)<tol; // se verdadeiro tem pigmento verde com tolerancia desejada
if TolOk then TolOk := abs(linha1[x].B-linha2[x].B)<tol; // se verdadeiro tem pigmento azul com tolerancia desejada
if TolOk then inc(cnt); // se verdadeiro soma +1 como sendo os pixels em img1[x,y] e img2[x,y] sendo semelhente
end;
result := cnt / (img1.Height * img1.Width) * 100; // retorna quanto % as imagem são semelhante
end;
end;
SEGUE CODIGO FUNCIONANDO:
function semelhanca(tol: byte; img1, img2: TImage): real;
type
TRGB32 = packed record
B, G, R, A: Byte;
end;
TRGB32Array = packed array[0..MaxInt div SizeOf(TRGB32)-1] of TRGB32;
PRGB32Array = ^TRGB32Array;
var
x, y: Integer;
TolOk: boolean;
cnt: longint;
abmp: Tbitmap;
linha1,linha2 : PRGB32Array;
begin
cnt := 0;
{ cria abmp na memoria }
abmp := Tbitmap.Create;
{ para caso a imagem no img1 não seja do tipo bmp que seja feita a conversão }
{ converte a imagem em img1 em bmp e depois devolve para img1 }
abmp.Width := img1.Picture.Bitmap.Width; //CORREÇÕES
abmp.Height := img1.Picture.Bitmap.Height; //CORREÇÕES
abmp.pixelformat := pf24bit;
abmp.Assign(img1.Picture.Graphic);
img1.AutoSize:=true; //CORREÇÕES
img1.Picture.Bitmap.Assign(abmp);
{ para caso a imagem no img2 não seja do tipo bmp que seja feita a conversão }
{ converte a imagem em img2 em bmp e depois devolve para img2 }
abmp.Width := img2.Picture.Bitmap.Width; //CORREÇÕES
abmp.Height := img2.Picture.Bitmap.Height; //CORREÇÕES
abmp.pixelformat := pf24bit;
abmp.Assign(img2.Picture.Graphic);
img2.AutoSize:=true; //CORREÇÕES
img2.Picture.Bitmap.Assign(abmp);
{ liberta abmp da memoria }
abmp.Free;
{loop de compração}
for y := 0 to img1.Height - 1 do
begin
linha1:=img1.Picture.Bitmap.ScanLine[y];// busca uma linha em img1
linha2:=img2.Picture.Bitmap.ScanLine[y];// busca uma linha em img2
for x := 0 to img1.Width - 1 do
begin
TolOk := true;
if TolOk then TolOk := abs(linha1[x].R-linha2[x].R)<tol; // se verdadeiro tem pigmento vermelho com tolerancia desejada
if TolOk then TolOk := abs(linha1[x].G-linha2[x].G)<tol; // se verdadeiro tem pigmento verde com tolerancia desejada
if TolOk then TolOk := abs(linha1[x].B-linha2[x].B)<tol; // se verdadeiro tem pigmento azul com tolerancia desejada
if TolOk then inc(cnt); // se verdadeiro soma +1 como sendo os pixels em img1[x,y] e img2[x,y] sendo semelhente
end;
result := cnt / (img1.Height * img1.Width) * 100; // retorna quanto % as imagem são semelhante
end;
end;
Responder
Gostei + 0
Clique aqui para fazer login e interagir na Comunidade :)