Сравнение Bitmap и bmp из photoshop

[yan11]

Здравствуйте.

Столкнулся с такой проблемой. Сохраняю изображение с помощью следующей функции, после чего вырезаю кусок сохранённого изображения с помощью фотошопа. В не зависимости от того как сохраняю BMP, поиск по картинке отказывает работать.

В то же время, если обе картинки сохраняю в фотошопе, поиск работает!
Подскажите пожалуйста как скорректировать работу функций чтобы картинки распознавались.



Функция сохранения изображения

function SavePartOfScreen(ARect : TRect; Way:string) : TBitmap;
var
  ScreenDC: HDC;
  Width, Height, Left, Top: integer;
begin
Result:=TBitmap.Create;

with result do
   begin

   Width:=ARect.Right-ARect.Left;
   Height:=ARect.Bottom-ARect.Top;
   Left:= ARect.Left;
   Top:= ARect.Top;

   ScreenDC:=GetDC(0);
   try
      BitBlt(Canvas.Handle, 0,0,Width,Height,ScreenDC, Left, Top, SRCCOPY );
      result.SaveToFile(Way);
   finally
   ReleaseDC(0, ScreenDC);
   end;
   end;
end;

Функция поиска картинки в картинке:

function SearchBitmap(bmMain, bmSub:TBitMap; var R:TRect):boolean;
type TIntArray = array [word] of integer;
     PIntArray = ^TIntArray;
var p0, p1, p2:PIntArray;
    x, y:integer;
    x1, y1, w, w0, w1, k : integer;
    b : boolean;
begin
   result := true;
   FillChar(R, sizeOf(R), 0);

   bmMain.PixelFormat:=pf32bit;
   bmSub.PixelFormat:=pf32bit;

   w  := bmMain.width;
   w0 := bmMain.Width*sizeOf(integer);
   w1 := bmSub.Width*sizeOf(integer);

   p0 := bmMain.ScanLine[0];
   p1 := bmSub.ScanLine[0];
   for y := 0 to bmMain.Height - bmSub.Height do begin
      for x := 0 to bmMain.Width - bmSub.Width do begin

         b := true;

         p2 := p1; k := 0;
         for y1 := 0 to bmSub.Height-1 do begin
            for x1 := 0 to bmSub.Width - 1 do begin
                if p0[k+x+x1] <> p2[x1] then begin
                   b := false;
                   break;
                end;
            end;
            if not b then break;
            integer(p2) := integer(p2) - w1;
            k := k - w;
         end;

         if b then begin
            R := Rect(x, y, x+bmSub.Width, y+bmSub.Height);
            exit;
         end;
      end;
      integer(p0) := integer(p0) - w0;
   end;
   result := false;
end;

[yan11]

Посмотрел я по-байтово файлы которые сохраняет программа и фотошоп.

Программа

Offset      0  1  2  3  4  5  6  7   8  9 10 11 12 13 14 15
00000000   42 4D 36 2E 00 00 00 00  00 00 36 00 00 00 28 00   BM6.......6...(.
00000016   00 00 40 00 00 00 2E 00  00 00 01 00 20 00 00 00   ..@......... ...
00000032   00 00 00 2E 00 00 00 00  00 00 00 00 00 00 00 00   ................
00000048   00 00 00 00 00 00 1A 72  6A FF 17 71 68 FF 14 6F   .......rjÿ.qhÿ.o
00000064   66 FF 11 6D 64 FF 0D 6C  62 FF 0C 6C 63 FF 0F 70   fÿ.mdÿ.lbÿ.lcÿ.p
00000080   66 FF 0E 71 67 FF 0D 71  67 FF 0C 72 67 FF 0A 73   fÿ.qgÿ.qgÿ.rgÿ.s
00000096   67 FF 09 72 67 FF 09 72  67 FF 0E 71 67 FF 16 6A   gÿ.rgÿ.rgÿ.qgÿ.j
00000112   62 FF 17 62 5D FF 19 5F  5F FF 24 68 6E FF 32 72   bÿ.b]ÿ.__ÿ$hnÿ2r

Фотошоп

Offset      0  1  2  3  4  5  6  7   8  9 10 11 12 13 14 15
00000000   42 4D 38 2E 00 00 00 00  00 00 36 00 00 00 28 00   BM8.......6...(.
00000016   00 00 40 00 00 00 2E 00  00 00 01 00 20 00 00 00   ..@......... ...
00000032   00 00 02 2E 00 00 12 0B  00 00 12 0B 00 00 00 00   ................
00000048   00 00 00 00 00 00 1A 72  6A 00 17 71 68 00 14 6F   .......rj..qh..o
00000064   66 00 11 6D 64 00 0D 6C  62 00 0C 6C 63 00 0F 70   f..md..lb..lc..p
00000080   66 00 0E 71 67 00 0D 71  67 00 0C 72 67 00 0A 73   f..qg..qg..rg..s
00000096   67 00 09 72 67 00 09 72  67 00 0E 71 67 00 16 6A   g..rg..rg..qg..j
00000112   62 00 17 62 5D 00 19 5F  5F 00 24 68 6E 00 32 72   b..b]..__.$hn.2r

Есть какой-то более простой способ решения кроме как перезаписывать биты?

[Alex11223]

Использовать не bmp, а какой-то другой формат (png, jpeg) + библиотеку для него (если Дельфи не умеет)

у bmp много вариантов формата https://en.wikipedia.org/wiki/BMP_file_format

[Pavia]

Компилятор Delphi или freepascal?

[Pavia]

Самое простое это убрать альфу. При присвоении. pf24bit, Delphi за вас биты перепишет. А потом pf32bit чтобы вернуть размерность,.

[Pavia]

При сравнении использовать маски тоже простое решение.

   if (p0[k+x+x1] and $ffffff) <> (p2[x1] and $ffffff) then begin

[yan11]

Методом тыка удалось решить проблему, вместо этого

BitBlt(Canvas.Handle, 0,0,Width,Height,ScreenDC, Left, Top, SRCCOPY );

сделал вот так

SetStretchBltMode(Canvas.Handle, HALFTONE);
StretchBlt(Canvas.Handle, 0, 0, Width, Height, ScreenDC, Left, Top, Width, Height, SRCCOPY);

Теперь картинка сохранённая программой, в HEX редакторе выглядит вот так вот:

Offset      0  1  2  3  4  5  6  7   8  9 10 11 12 13 14 15

00000000   42 4D 36 2E 00 00 00 00  00 00 36 00 00 00 28 00   BM6.......6...(.
00000016   00 00 40 00 00 00 2E 00  00 00 01 00 20 00 00 00   ..@......... ...
00000032   00 00 00 2E 00 00 00 00  00 00 00 00 00 00 00 00   ................
00000048   00 00 00 00 00 00 7F 65  5A 00 80 66 5A 00 80 67   ......eZ.€fZ.€g
00000064   5B 00 81 67 5B 00 82 68  5C 00 82 68 5C 00 83 69   [.g[.‚h\.‚h\.ƒi
00000080   5D 00 84 6A 5D 00 85 6A  5E 00 85 6B 5E 00 86 6B   ].„j].…j^.…k^.†k
00000096   5F 00 87 6C 60 00 82 68  5D 00 8B 81 7F 00 D2 DE   _.‡l`.‚h].‹.ÒÞ
00000112   EE 00 D2 DE EE 00 D2 DE  EE 00 D2 DE EE 00 D3 DE   î.ÒÞî.ÒÞî.ÒÞî.ÓÞ
00000128   EE 00 D3 DE EE 00 D3 DE  EE 00 D3 DE EE 00 D3 DE   î.ÓÞî.ÓÞî.ÓÞî.ÓÞ
00000144   EE 00 D3 DE EE 00 D3 DE  EE 00 D3 DE EE 00 CB D6   î.ÓÞî.ÓÞî.ÓÞî.ËÖ
00000160   E5 00 BF C9 D8 00 D1 DD  EE 00 D2 DD EE 00 D2 DD   å.¿ÉØ.ÑÝî.ÒÝî.ÒÝ