PDA

View Full Version : مقایسه دو تصویر کاملا شبیه هم



na_3_er
پنج شنبه 13 فروردین 1394, 00:56 صبح
چطوری میتونم به دلفی اگر دو تا عکس دادم اگر صد در صد شبیه هم دادن true و اگر شبیه هم نبودن false بهم برگردونه خیلی واسم مهمه اگر هم کدشو بلد نیستین یه سرنخ بدین برم دونبالش

و یه مقالیه ایی چیزی لینکی برای پردازش تصویر میخوام کلا به چه شکل هست

ret_ie
شنبه 15 فروردین 1394, 23:01 عصر
با سلام. من یک برنامه Sample با سورس کامل به شما معرفی میکنم که اگه به دقت کدش رو بررسی کنید درصد زیادی از مشکلتون حل میشه. این برنامه یک الگوریتمه که یک فایل رو در قالب یک تصویر جاسازی میکنه و در موقع نیاز اون رو بر میگردونه.
در قسمتی از این کد، پیکسل به پیکسل عکس خونده میشه و بخشی از اطلاعات فایل در بایتهای مربوط به اون پیکسل جا داده میشه و سپس پیکسل و بایت بعدی. این حلقه تکرار دقیقا چیزیه که باید روش تمرکز کنید:
http://delphi.about.com/od/fullcodeprojects/a/delphi-steganography-data-cryptography-image.htm

دلفــي
یک شنبه 16 فروردین 1394, 08:13 صبح
چطوری میتونم به دلفی اگر دو تا عکس دادم اگر صد در صد شبیه هم دادن true و اگر شبیه هم نبودن false بهم برگردونه خیلی واسم مهمه اگر هم کدشو بلد نیستین یه سرنخ بدین برم دونبالش

و یه مقالیه ایی چیزی لینکی برای پردازش تصویر میخوام کلا به چه شکل هست



Function CompImages(Picture1, Picture2: TBitmap):Boolean;
var
x, y : Integer;
begin
Assert(Picture1.PixelFormat = Picture2.PixelFormat);
for x := 0 to Picture1.Height - 1 do
begin
for y := 0 to Picture1.Width - 1 do
if Picture1.Canvas.Pixels[x,y] <> Picture2.Canvas.Pixels[x,y] then
begin
Result := False;
Exit;
end;
end;
Result := True;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
if CompImages(Image1.Picture.Bitmap,Image2.Picture.Bi tmap) then
ShowMessage('دو تصوير باهم برابرند') else
ShowMessage('دو تصوير باهم متفاوت هستند');
end;

golbafan
یک شنبه 16 فروردین 1394, 08:50 صبح
سلام
در تکمیل توضیحات آقای دلفــي (http://barnamenevis.org/member.php?117857-%D8%AF%D9%84%D9%81%D9%80%D9%80%D9%8A)
میتونید بجای مقایسه تمام پیکسل های موجود در تصویر از scanline استفاده کنید تا تعداد محاسباتتون بسیار کمتر بشه (جذر بشه)
یعنی بجای 10.000 محاسبه فقط میتونید با 100 محاسبه این کار رو انجام بدید:

for y := 0 to BitMap1.Height - 1 do
begin
P1 := BitMap1.ScanLine[y];
P2 := BitMap2.ScanLine[y];
if p1<>p2 then result:=false;
end;

همچنین میتونید با مقایسه هیستوگرام رنگی دوتصویر که از لحاظ اندازه برابر هستند به تساوی بودن اونها پی ببرید

procedure TForm1.Button1Click(Sender: TObject);
var
b1, b2: TBitmap;
c1, c2: PByte;
x, y, i,different: integer;
begin
b1 := Image1.Picture.Bitmap;
b2 := Image2.Picture.Bitmap;
Assert(b1.PixelFormat = b2.PixelFormat);
different := 0;
for y := 0 to b1.Height - 1 do
begin
c1 := b1.Scanline[y];
c2 := b2.Scanline[y];
for x := 0 to b1.Width - 1 do
for i := 0 to BytesPerPixel - 1 do
begin
Inc(different, Integer(c1^ <> c2^));
Inc(c1);
Inc(c2);
end;
end;
if different=0 then
showmessage('مساوی')
else
showmessage('نا مساوی');
end;

rahnema1
چهارشنبه 19 فروردین 1394, 06:57 صبح
for y := 0 to BitMap1.Height - 1 do
begin
P1 := BitMap1.ScanLine[y];
P2 := BitMap2.ScanLine[y];
if p1<>p2 then result:=false;
end;

سلام
این روش اشتباهه چون داره اشاره گر به اولین عنصر هر سطر را با هم مقایسه می کنه و اصلا محتوای اون که پیکسلهای هر سطر هست نادیده گرفته شده


همچنین میتونید با مقایسه هیستوگرام رنگی دوتصویر که از لحاظ اندازه برابر هستند به تساوی بودن اونها پی ببرید

مساوی بودن هیستوگرام دو تصویر لزوما به معنای مساوی بودن دو تصویر نیست
در مورد تکه کد آخر که در واقع میاد تمام پیکسلها را با هم مقایسه می کنه می شه اینجور روش را بهبود داد که به محض رسیدن به اولین اختلاف دو تصویر حلقه break بشه و نتیجه نمایش داده بشه