این کد مقایسه دوتصویر 24 بیتی با همه

[علیرضا110]

این کد برای مقایسه دو عکس 24 بیتی یا 32 بیتی هستش بدون هیچ کامپوننتی گفتم شاید به درد کسی بخوره



function CompareBitmaps(ABitmap1, ABitmap2: TBitmap;
var ADiffPixel: TPoint): Boolean;
var
X, Y: Integer;
Size: Integer;
Pixels1, Pixels2: PByteArray;
begin
// first check if both bitmaps match in size and pixel format
Result := (ABitmap1.PixelFormat = ABitmap2.PixelFormat) and
(ABitmap1.Width = ABitmap2.Width) and (ABitmap1.Height = ABitmap2.Height);
// if so, then...
if Result then
begin
// assign the size of one pixel
case ABitmap1.PixelFormat of
pf24bit: Size := SizeOf(TRGBTriple);
pf32bit: Size := SizeOf(TRGBQuad);
else
raise Exception.Create('Bitmap must be 24-bit or 32-bit format!');
end;
// iterate all the bitmap rows
for Y := 0 to ABitmap1.Height - 1 do
begin
// get pointer to pixel data array of the same row for both bitmaps
Pixels1 := ABitmap1.ScanLine[Y];
Pixels2 := ABitmap2.ScanLine[Y];
// compare those pixel data arrays; if they differ, then...
if not CompareMem(Pixels1, Pixels2, ABitmap1.Width * Size) then
begin
// return negative result
Result := False;
// assign vertical pixel position to the output ADiffPixel parameter
ADiffPixel.Y := Y;
// iterate the current row to find a different pixel; after it's found
// the pixel's horizontal position is stored to the output ADiffPixel
// parameter; the pixel array is treated as a byte array, so there's
// need to be a division by the pixel size
for X := 0 to ABitmap1.Width * Size - 1 do
if (Pixels1[X] <> Pixels2[X]) then
begin
ADiffPixel.X := X div Size;
Exit;
end;
end;
end;
end
else
raise Exception.Create('Bitmaps must match in size and pixel format!');
end;


procedure TForm1.Button3Click(Sender: TObject);
var
PixelPos: TPoint;
begin
if CompareBitmaps(Image1.Picture.Bitmap, Image2.Picture.Bitmap, PixelPos) then
ShowMessage('Bitmaps are the same!')
else
ShowMessage('Bitmaps are different! The first different pixel was found ' +
'at [' + IntToStr(PixelPos.X) + '; ' + IntToStr(PixelPos.Y) + '].');
end;