10.01.2013, 16:21
|
|
Прохожий
|
|
Регистрация: 13.01.2010
Сообщения: 27
Репутация: 10
|
|
Проблема частично решена. Изображение строится, но, видимо, где-то допущена логическая ошибка, поскольку прорисовывается не полное изображение. Код :
Код:
function Create_16x16(Img: TBitmap): TMas16x16;
type
MasX = PByteArray;
var
MasY: array of MasX; // битмап в памяти как массив (Y x X)
j, i: Integer;
xLeft, xRight, yTop, yBottom: Integer; // абс. коорд. образа
ki, kj: Integer;
nSymbol: Integer; // кол-во значимых пикселей
Percent: double; // процент заполнения
XY: array [0 .. 16] of record X, Y: Integer end; // относительные координаты анализируемых ячеек
W, H: Integer; // ширина и высота образа
begin
SetLength(MasY, Img.Height); // выделяем память под битмап
for j := 0 to Img.Height - 1 do // получаем отображение битмапа в массиве
MasY[j] := Img.ScanLine[j]; // MasY[y - координата][x - координата] = знач. пикселя (x,y)
// -------- получение координат границ образа ---------------------------------
// здесь и далее предполагается что значение MasY[y][x] = 0 соответствует черному цвету пикселя
xLeft := -1; // инициализация
xRight := -1;
yTop := -1;
yBottom := -1;
for j := 0 to Img.Height - 1 do // Top
begin
for i := 0 to Img.Width - 1 do
if MasY[j][i] = 0 then
begin
yTop := j;
break;
end;
if yTop = j then
break;
end;
for j := Img.Height - 1 downto 0 do // Bottom
begin
for i := 0 to Img.Width - 1 do
if MasY[j][i] = 0 then
begin
yBottom := j + 1;
break;
end;
if yBottom = j + 1 then
break;
end;
for i := 0 to Img.Width - 1 do // Left
begin
for j := 0 to Img.Height - 1 do
if MasY[j][i] = 0 then
begin
xLeft := i;
break;
end;
if xLeft = i then
break;
end;
for i := Img.Width - 1 downto 0 do // Right
begin
for j := 0 to Img.Height - 1 do
if MasY[j][i] = 0 then
begin
xRight := i + 1;
break;
end;
if xRight = i + 1 then
break;
end;
// ----------------------------------------------------------------------------
if ((yBottom - yTop) * (xRight - xLeft)) = 0 then // если ничего не нарисовано
begin
exit;
end;
// ----------------------------------------------------------------------------
// получаем процент заполнения как отношение кол-ва значимых пикселей к общему
// кол-ву пикселей в границах образа
// Percent будет необходим при анализе каждой ячейки в разбитом на 16х16 образе
nSymbol := 0;
for j := yTop to yBottom-1 do
for i := xLeft to xRight-1 do
if MasY[j][i] = 0 then
inc(nSymbol);
Percent := nSymbol / ((yBottom - yTop) * (xRight - xLeft));
Percent := 0.99 * Percent; // коэф-т влияет на формирование матрицы 16х16
// > 1 - учитывается меньше значимых пикселей
// < 1 - учитывается больше значимых пикселей
// ----------------------------------------------------------------------------
// ----------------------------------------------------------------------------
// разбиваем прямоугольник образа на 16 равных частей путем деления сторон на 2
// и получаем относительные координаты каждой ячейки
W := xRight - xLeft;
XY[0].X := 0;
XY[16].X := W;
XY[8].X := XY[16].X div 2;
XY[4].X := XY[8].X div 2;
XY[2].X := XY[4].X div 2;
XY[1].X := XY[2].X div 2;
XY[3].X := (XY[4].X + XY[2].X) div 2;
XY[6].X := (XY[8].X + XY[4].X) div 2;
XY[5].X := (XY[6].X + XY[4].X) div 2;
XY[7].X := (XY[8].X + XY[6].X) div 2;
XY[12].X := (XY[16].X + XY[8].X) div 2;
XY[10].X := (XY[12].X + XY[8].X) div 2;
XY[14].X := (XY[16].X + XY[12].X) div 2;
XY[9].X := (XY[10].X + XY[8].X) div 2;
XY[11].X := (XY[12].X + XY[10].X) div 2;
XY[13].X := (XY[14].X + XY[12].X) div 2;
XY[15].X := (XY[16].X + XY[14].X) div 2;
H := yBottom - yTop;
XY[0].Y := 0;
XY[16].Y := H;
XY[8].Y := XY[16].Y div 2;
XY[4].Y := XY[8].Y div 2;
XY[2].Y := XY[4].Y div 2;
XY[1].Y := XY[2].Y div 2;
XY[3].Y := (XY[4].Y + XY[2].Y) div 2;
XY[6].Y := (XY[8].Y + XY[4].Y) div 2;
XY[5].Y := (XY[6].Y + XY[4].Y) div 2;
XY[7].Y := (XY[8].Y + XY[6].Y) div 2;
XY[12].Y := (XY[16].Y + XY[8].Y) div 2;
XY[10].Y := (XY[12].Y + XY[8].Y) div 2;
XY[14].Y := (XY[16].Y + XY[12].Y) div 2;
XY[9].Y := (XY[10].Y + XY[8].Y) div 2;
XY[11].Y := (XY[12].Y + XY[10].Y) div 2;
XY[13].Y := (XY[14].Y + XY[12].Y) div 2;
XY[15].Y := (XY[16].Y + XY[14].Y) div 2;
// ----------------------------------------------------------------------------
// ----------------------------------------------------------------------------
// анализируем каждую полученную ячейку в разбитом прямоугольнике образа
// и создаем приведенную матрицу 16x16
for kj := 0 to 15 do
for ki := 0 to 15 do
begin
//ShowMessage(IntToStr(yTop + XY[kj].Y));
//ShowMessage(IntToStr((yTop + XY[kj + 1].Y)-1));
//ShowMessage(IntToStr(xLeft + XY[ki].X));
//ShowMessage(IntToStr((xLeft + XY[ki + 1].X)-1));
nSymbol := 0;
for j := yTop + XY[kj].Y to ((yTop + XY[kj + 1].Y)-1) do
// пробегаемся по ячейкам уже
for i := xLeft + XY[ki].X to ((xLeft + XY[ki + 1].X)-1) do
// в абсолютных координатах
if MasY[j][i] = 0 then
inc(nSymbol); // считаем кол-во значимых пикселей (=0 -> черный цвет)
// если отношение кол-ва знач. пикселей к общему кол-ву в ящейке > характерного процента заполнения то = 1 иначе = 0
if nSymbol / MAX(1, ((1+XY[ki + 1].X - XY[ki].X) * (1+XY[kj + 1].Y - XY[kj].Y)
)) > Percent then
Result[kj][ki] := 1
else
Result[kj][ki] := 0; // результат - приведенная матрица 16х16
end;
SetLength(MasY, 0); // уже не нужно...
end;
Код:
MasChar := Create_16x16(Image2.Picture.Bitmap);
PB16x16.Repaint; // типа очистка
with PB16x16.Canvas do // рисуем приведенную матрицу (это необязательно...)
for kj := 0 to 15 do
for ki := 0 to 15 do
begin
Brush.Color := clRed;
if MasChar[kj][ki] = 1 then
Brush.Style := bsSolid
else
Brush.Style := bsClear;
Rectangle(ki * 7, kj * 7, ki * 7 + 7, kj * 7 + 7);
end; |
Линейный вид
