是高手的进来,!!!!!!!!!!!!! ( 积分: 100 )

  • 主题发起人 主题发起人 dldengli
  • 开始时间 开始时间
D

dldengli

Unregistered / Unconfirmed
GUEST, unregistred user!
有两张图片,其中有部分区域是不同的,要求能快速找出不同区域的RECT。以下是小弟我写的,但速度那是不堪忍受啊[:(]。望各位高手、大虾门明白我的意思帮我想出快速的算法来小第在此先谢过了!!!。可以使用线程最好不要超过2个。
function CpBmp(var B1, B2: TBitmap): TRect;
var
R1, R2 : pRGBArray;
i, l : integer;
x1, x2, y1, y2 : integer;
bb:boolean;
begin
bb:= false;
for i:= 0 to B1.Height - 1 do
begin
if bb then break;
R1:= B1.ScanLine;
R2:= B2.ScanLine;
for l:= 0 to B1.Width -1 do
begin
if rgb(R1[l].rgbtRed,r1[l].rgbtGreen,r1[l].rgbtBlue) <>
rgb(R2[l].rgbtRed,r2[l].rgbtGreen,r2[l].rgbtBlue) then
begin
y1:= i;
bb:= true;
break;
end;
end;
end;

bb:= false;
for i:= B1.Height - 1 downto 0 do
begin
if bb then break;
R1:= B1.ScanLine;
R2:= B2.ScanLine;
for l:= 0 to B1.Width -1 do
begin
if rgb(R1[l].rgbtRed,r1[l].rgbtGreen,r1[l].rgbtBlue) <>
rgb(R2[l].rgbtRed,r2[l].rgbtGreen,r2[l].rgbtBlue) then
begin
y2:= i;
bb:= true;
Break;
end;
end;
end;

bb:= false;
for i:= 0 to B1.Width - 1 do
begin
if bb then break;
for l:= 0 to B1.Height - 1 do
begin
if b1.Canvas.Pixels[i,l] <> b2.Canvas.Pixels[i,l] then
begin
x1:= i;
bb:= true;
Break;
end;
end;
end;

bb:= false;
for i:= B1.Width - 1 downto 0 do
begin
if bb then break;
for l:= 0 to B1.Height - 1 do
begin
if b1.Canvas.Pixels[i,l] <> b2.Canvas.Pixels[i,l] then
begin
x2:= i;
bb:= true;
Break;
end;
end;
end;

Result:= Rect(x1,y1,x2,y2);
end;
 
有两张图片,其中有部分区域是不同的,要求能快速找出不同区域的RECT。以下是小弟我写的,但速度那是不堪忍受啊[:(]。望各位高手、大虾门明白我的意思帮我想出快速的算法来小第在此先谢过了!!!。可以使用线程最好不要超过2个。
function CpBmp(var B1, B2: TBitmap): TRect;
var
R1, R2 : pRGBArray;
i, l : integer;
x1, x2, y1, y2 : integer;
bb:boolean;
begin
bb:= false;
for i:= 0 to B1.Height - 1 do
begin
if bb then break;
R1:= B1.ScanLine;
R2:= B2.ScanLine;
for l:= 0 to B1.Width -1 do
begin
if rgb(R1[l].rgbtRed,r1[l].rgbtGreen,r1[l].rgbtBlue) <>
rgb(R2[l].rgbtRed,r2[l].rgbtGreen,r2[l].rgbtBlue) then
begin
y1:= i;
bb:= true;
break;
end;
end;
end;

bb:= false;
for i:= B1.Height - 1 downto 0 do
begin
if bb then break;
R1:= B1.ScanLine;
R2:= B2.ScanLine;
for l:= 0 to B1.Width -1 do
begin
if rgb(R1[l].rgbtRed,r1[l].rgbtGreen,r1[l].rgbtBlue) <>
rgb(R2[l].rgbtRed,r2[l].rgbtGreen,r2[l].rgbtBlue) then
begin
y2:= i;
bb:= true;
Break;
end;
end;
end;

bb:= false;
for i:= 0 to B1.Width - 1 do
begin
if bb then break;
for l:= 0 to B1.Height - 1 do
begin
if b1.Canvas.Pixels[i,l] <> b2.Canvas.Pixels[i,l] then
begin
x1:= i;
bb:= true;
Break;
end;
end;
end;

bb:= false;
for i:= B1.Width - 1 downto 0 do
begin
if bb then break;
for l:= 0 to B1.Height - 1 do
begin
if b1.Canvas.Pixels[i,l] <> b2.Canvas.Pixels[i,l] then
begin
x2:= i;
bb:= true;
Break;
end;
end;
end;

Result:= Rect(x1,y1,x2,y2);
end;
 
没有人回答自己顶。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。
 
ha ha
帮你顶
 
你不是用了ScanLine了吗? 怎么又用Canvas.Pixels ? 这很慢的

&quot;if b1.Canvas.Pixels[i,l] <> b2.Canvas.Pixels[i,l] then&quot;
 
你这个程序真的能运行吗?
两个图片什么尺寸,谁大谁小呢,还是一样大?
 
这段代码是有问题错误是
rgb(R1[l].rgbtRed,r1[l].rgbtGreen,r1[l].rgbtBlue) <> rgb(R2[l].rgbtRed,r2[l].rgbtGreen,r2[l].rgbtBlue) 这里,换成 b1.Canvas.Pixels[i,l] <> b2.Canvas.Pixels[i,l]就没有问题,写上面的代码我只是想将问题说的更清楚点,顺便说下图片是一样大的。
 
这个你看成不成
function TForm1.test(var B1, B2: TBitmap): TRect;
var
i, j, k : integer;
row1, row2 : pByteArray;
BytesPerPixel : integer;
firstt : boolean;
x1, y1, x2, y2 : integer;
begin

case B1.PixelFormat of
pf1bit: BitsPerPixel := 1; //???
pf8bit: BitsPerPixel := 1;
pf16bit: BitsPerPixel := 2;
pf32bit: BitsPerPixel := 4;
end;

firstt := true;
firstl := true;

x1 := 0;
x2 := 0;
y1 := 0;
y2 := 0;

for i := 0 to B1.Height - 1 do
begin
row1 := pByteArray(B1.Scanline);
row2 := pByteArray(B2.Scanline);
for j := 0 to B1.Width - 1 do
begin
for k := 0 to BitsPerPixel - 1 do
begin
if row1[j * BitsPerPixel + k] <> row2[j * BitsPerPixel + k] then
begin
if firstt then
begin
y1 := i;
x1 := j;
y2 := i;
x2 := j;
firstt := false;
end
else
begin
if j < x1 then x1 := j;
if i > y2 then y2 := i;
if j > x2 then x2 := j;
end;
break;
end;
end;
end;

end;
result := Rect(x1, y1, x2, y2);
end;

我没有仔细的试过,如果能用记得给分,嘿嘿
 
to:bjyplbx
你的代码的确可以,但是我想知道你这段代码的row1[j * BitsPerPixel + k]这个地方为何意,如何理解?望能回复。
 
to 搂主:
我的程序只是个简单的处理,你优化一下,要是能确定你的位图是多少色的处理起来会更方便。BitsPerPixel 表示多少字节代表一个象素
pf1bit: BitsPerPixel := 1; //???我这样写有问题,这个表示一bit一个pixel
pf8bit: BitsPerPixel := 1; //1字节
pf16bit: BitsPerPixel := 2; //2字节
pf32bit: BitsPerPixel := 4; //4字节
 
试试这个,我处理的单色的情况,我没有大图不清楚速度
你有更好的办法了记得说说
uses QGraphics;//

function test(var B1, B2: TBitmap): TRect;
var
i, j, k : integer;
row1, row2 : PByteArray;
BytesPerPixel : integer;
x1, y1, x2, y2 : integer;
pix1, pix2 : array of byte;
isFirst : boolean;
BitsCount, FreeBits, a: integer;
begin

case B1.PixelFormat of
pf1bit: BytesPerPixel := 0; //单色
pf8bit: BytesPerPixel := 1; //
pf16bit: BytesPerPixel := 2; //
pf32bit: BytesPerPixel := 4; //
else
BytesPerPixel := 4;
end;

isFirst := true;

x1 := 0;
x2 := 0;
y1 := 0;
y2 := 0;

if BytesPerPixel = 0 then
begin
if B1.Width mod 8 = 0 then
begin
setlength(pix1, B1.Width div 8);
setlength(pix2, B1.Width div 8);
FreeBits := 0;
end
else
begin
setlength(pix1, 1 + (B1.Width - 1) div 8);
setlength(pix2, 1 + (B1.Width - 1) div 8);
FreeBits := B1.Width mod 8;
end;

for i := 0 to B1.Height - 1 do
begin
BitsCount := 0;
row1 := PByteArray(B1.Scanline);
row2 := PByteArray(B2.Scanline);
//横向取一***行***象素 (按字节)
move(row1[j * BytesPerPixel], pix1[0], Sizeof(pix1));
move(row2[j * BytesPerPixel], pix2[0], Sizeof(pix2));
for j := low(pix1) to high(pix1) do
begin
if (j + 1) * 8 > B1.Width then
begin
pix1[j] := pix1[j] shr (8 - FreeBits);
pix1[j] := pix1[j] shl (8 - FreeBits);
pix2[j] := pix2[j] shr (8 - FreeBits);
pix2[j] := pix2[j] shl (8 - FreeBits);
end;
a := 0;
case (pix1[j] xor pix2[j]) of
0: a := -1; //相等
1: a := 7;
2: a := 6;
4: a := 5;
8: a := 4;
16: a := 3;
32: a := 2;
64: a := 1;
128: a := 0;
end;
if a > -1 then
if isFirst then //第一个不同象素
begin
y1 := i;
x1 := j * 8 + a;
y2 := i;
x2 := j * 8 + a;
isFirst := false;
end
else
begin
//y1 := i;
if (j * 8 + a) < x1 then x1 := j * 8 + a;
if i > y2 then y2 := i;
if (j * 8 + a) > x2 then x2 := j * 8 + a;
end;
end;
end;
end
else
begin
setlength(pix1, BytesPerPixel);
setlength(pix2, BytesPerPixel);

for i := 0 to B1.Height - 1 do
begin
row1 := PByteArray(B1.Scanline);
row2 := PByteArray(B2.Scanline);
for j := 0 to B1.Width - 1 do
begin
//横向取一***个***象素
move(row1[j * BytesPerPixel], pix1[0], Sizeof(pix1));
move(row2[j * BytesPerPixel], pix2[0], Sizeof(pix2));

for k := low(pix1) to high(pix1) do //字节比较
begin
if pix1[k] <> pix2[k] then
begin
if isFirst then //第一个不同象素
begin
y1 := i;
x1 := j;
y2 := i;
x2 := j;
isFirst := false;
end
else
begin
if j < x1 then x1 := j;
if i > y2 then y2 := i;
if j > x2 then x2 := j;
end;
break;
end;
end;
end;
end;
end;
pix1 := nil;
pix2 := nil;
result := Rect(x1, y1, x2, y2);
end;
 
to:bjyplbx
非常感谢你能提供帮助,我实在是对图形处理这方面很不在行,实际上用你上此的那段代码对处理一般的图片速度还可以,在对大图片做处理的时候我还是用线程来做处理。
qq:30290373实在是不敢留邮件箱,垃圾邮件太多了。
 

Similar threads

S
回复
0
查看
917
SUNSTONE的Delphi笔记
S
S
回复
0
查看
897
SUNSTONE的Delphi笔记
S
I
回复
0
查看
432
import
I
后退
顶部