Поиск координат прямоугольника в bmp

Нужно определить координаты верхнего левого угла прямоугольника, исходные данные:

  1. файл bmp, палитра, pf1bit, два цвета(черный + белый(прямоугольник))
  2. размер картинки 409(ширина)х256(высота) пикс, создана в Пэинт(виндовоз7)

код функции, две версии из букварей

    function FindRect(const aBitmap: Vcl.Graphics.TBitmap; var aTop, aLeft, aRight, aBottom: Integer): Boolean;
var
  H, W: Integer;
  Br: Boolean;
  //Clr: TColor; без разницы
  Clr: Integer;

  Line: pByteArray;
  bClr: Byte;

  pLine, pClr: PByte;
begin
  Result := false;

  (* find left-top pixel of rect *)

  (* versus pByteArray + Byte *)
  if Main.CheckBox1.Checked then
  begin
    // bClr := 0;
    for H := 0 to aBitmap.Height - 1 do
    begin
      Line := aBitmap.ScanLine[H];
      ShowMessage('Line_Color: ' + IntToStr(Line[10]) + '-> h: ' + IntToStr(H));

      for W := 0 to aBitmap.Width - 1 do //
      begin
        bClr := Line[W]; // Exception class $C0000005 после первой итерации
        ShowMessage('H: ' + IntToStr(H));
        ShowMessage('W: ' + IntToStr(W));
        ShowMessage('Clrs: ' + IntToStr(bClr));

        Inc(Line, 1);
      end;

    end;
  end;
  (* ------------------------------ *)

  (* versus PByte + Int *)
  if not(Main.CheckBox1.Checked) then
  begin
    for H := 0 to aBitmap.Height - 1 do
    begin
      pLine := aBitmap.ScanLine[H];
      ShowMessage('pLine_Color: ' + IntToStr(pLine[10]) + '-> h: ' + IntToStr(H));

      for W := 0 to aBitmap.Width - 1 do //
      begin
        Clr := pLine[W]; // white = 255

        if (Clr > 0) then
        begin
          ShowMessage('H: ' + IntToStr(H));
          ShowMessage('W: ' + IntToStr(W));
          ShowMessage('Clr: ' + IntToStr(Clr));
        end;

        Inc(pLine, 1);
      end;

    end;
  end;
  (* ------------------------------ *)

  Result := true;
end;

код использования

    var
  Main: TMain;
  bt_out: Vcl.Graphics.TBitmap;
implementation
{$R *.dfm}
Uses uFunc;

procedure TMain.Button1Click(Sender: TObject);
var
  rTop, rLeft, rRigth, rBottom: Integer;
begin
  if FindRect(bt_out, rTop, rLeft, rRigth, rBottom) then
    Memo1.Lines.Add(IntToStr(rTop) + ': ' + IntToStr(rLeft) + ': ' + IntToStr(rRigth) + ': ' +
      IntToStr(rBottom));
end;

procedure TMain.FormCreate(Sender: TObject);
begin
  bt_out := TBitmap.Create;
  bt_out.PixelFormat := pf1bit;
  bt_out.LoadFromFile('7.bmp');

  if (bt_out.PixelFormat = pf1bit) then
    Image1.Picture.Assign(bt_out); // для контроля
end;

procedure TMain.FormDestroy(Sender: TObject);
begin
  FreeAndNil(bt_out);
end;

initialization

ReportMemoryLeaksOnShutdown := True;

end.

Проблемы

  1. (* versus pByteArray + Byte *)
  • первая итерация происходит (0: 0: черный цвет)
  • следующая итерация (0: 1: ) вызывает исключение bClr := Line[W]; // Exception class $C0000005 (программа попыталась получить доступ к памяти, которая не была выделена ей или которую она не имеет права использовать????)
  1. (* versus PByte + Int *)
  • так то почти работает, но при проходе (18(строка18 pLine := aBitmap.ScanLine[H];): 0():) почемуто Clr := pLine[W]; выдает белый цвет(255), хотя там первые 9 пихелей черный цвет, только 10 пиксель и далее белые

Вопросы где косяк? что-то связанное с указателями (property ScanLine[Row: Integer]: Pointer;). как раз указатели у меня слабое место

rect


Ответы (0 шт):