[exy]

Есть такая ситуация. У меня есть черно-белое BMP-изображение. Я вырезаю из него кусок, вставляю в другой Image. Получается изображение 160 на 160 пикселей. После чего мне бы надо разбить его на клетки 10 на 10 пикселей и если в клеттке более половины пикселей черные, представить весь квадрат черным, если нет - белым. И в итоге полностью перерисовать вырезанное изображение в PaintBox таким образом. подскажите как это можно сделать?

[exy]

Проблема частично решена. Изображение строится, но, видимо, где-то допущена логическая ошибка, поскольку прорисовывается не полное изображение. Код :

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167

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;

Код:

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

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;

[icWasya]

Говоришь - чёрно-белое, а у самого полноцветное изображение.
А у него на один пиксель приходится три байта.
Может быть проблемы из за этого.

[exy]

Ну, во-первых, изображение действительно черно-белое. Во-вторых, проблема явно не в этом, так как пробовал делать и 8 бит и 4 бит и т.д. - суть не меняется.