Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 05.12.2024, 12:42   #1
Pcrepair
Форумчанин
 
Регистрация: 04.01.2011
Сообщений: 267
По умолчанию Поиск координат прямоугольника в 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 (программа попыталась получить доступ к памяти, которая не была выделена ей или которую она не имеет права использовать????) 

2) (* versus PByte + Int *)
- так то почти работает, но при проходе (18(строка18 pLine := aBitmap.ScanLine[H];): 0():) почемуто Clr := pLine[W]; выдает белый цвет(255), хотя там первые 9 пихелей черный цвет, только 10 пиксель и далее белые 

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

Заранее спасибо за ответы по ЗАДАННЫМ вопросам
Изображения
Тип файла: bmp 7.bmp (13.1 Кб, 5 просмотров)
Pcrepair вне форума Ответить с цитированием
Старый 05.12.2024, 14:20   #2
evg_m
Старожил
 
Регистрация: 20.04.2008
Сообщений: 5,541
По умолчанию

Цитата:
1) (* versus pByteArray + Byte *)
- первая итерация происходит (0: 0: черный цвет)
- следующая итерация (0: 1: ) вызывает исключение bClr := Line[W]; // Exception class $C0000005 (программа попыталась получить доступ к памяти, которая не была выделена ей или которую она не имеет права использовать????)
Код:
var
  Line: pByteArray;

      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); мы СБИЛИ адрес массива, а навигация в данном массиве уже ЕСТЬ  [W]
      end;
программа — запись алгоритма на языке понятном транслятору
evg_m вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Составить описание класса прямоугольника со сторонами, параллельными осям координат(С++) APTEMKA01 Помощь студентам 3 02.11.2018 21:03
Поиск доступных координат, из имеющихся. ivantu Общие вопросы Delphi 7 31.01.2016 14:45
Составить описание класса прямоугольника со сторонами, параллельными осям координат gylayko Помощь студентам 2 23.02.2013 21:38
Поиск прямоугольника в матрице seo-romka Помощь студентам 0 24.05.2011 19:20
Поиск координат мыши на рельефе OpenGL AngelOfDeathSX Мультимедиа в Delphi 1 12.03.2011 12:40