Поиск координат прямоугольника в bmp
Нужно определить координаты верхнего левого угла прямоугольника, исходные данные:
- файл bmp, палитра, pf1bit, два цвета(черный + белый(прямоугольник))
- размер картинки 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.
Проблемы
- (* versus pByteArray + Byte *)
- первая итерация происходит (0: 0: черный цвет)
- следующая итерация (0: 1: ) вызывает исключение bClr := Line[W]; // Exception class $C0000005 (программа попыталась получить доступ к памяти, которая не была выделена ей или которую она не имеет права использовать????)
- (* versus PByte + Int *)
- так то почти работает, но при проходе (18(строка18 pLine := aBitmap.ScanLine[H];): 0():) почемуто Clr := pLine[W]; выдает белый цвет(255), хотя там первые 9 пихелей черный цвет, только 10 пиксель и далее белые
Вопросы где косяк? что-то связанное с указателями (property ScanLine[Row: Integer]: Pointer;). как раз указатели у меня слабое место
