Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > Графика и игры
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 10.01.2013, 13:07
exy exy вне форума
Прохожий
 
Регистрация: 13.01.2010
Сообщения: 27
Репутация: 10
По умолчанию Проблема с изменением изображения

Есть такая ситуация. У меня есть черно-белое BMP-изображение. Я вырезаю из него кусок, вставляю в другой Image. Получается изображение 160 на 160 пикселей. После чего мне бы надо разбить его на клетки 10 на 10 пикселей и если в клеттке более половины пикселей черные, представить весь квадрат черным, если нет - белым. И в итоге полностью перерисовать вырезанное изображение в PaintBox таким образом. подскажите как это можно сделать?
Ответить с цитированием
  #2  
Старый 10.01.2013, 16:21
exy exy вне форума
Прохожий
 
Регистрация: 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;
Изображения
Тип файла: jpg Безымянный.jpg (37.4 Кбайт, 11 просмотров)
Ответить с цитированием
  #3  
Старый 10.01.2013, 16:48
icWasya icWasya вне форума
Местный
 
Регистрация: 09.11.2010
Сообщения: 499
Репутация: 10
По умолчанию

Говоришь - чёрно-белое, а у самого полноцветное изображение.
А у него на один пиксель приходится три байта.
Может быть проблемы из за этого.
Ответить с цитированием
  #4  
Старый 10.01.2013, 16:50
exy exy вне форума
Прохожий
 
Регистрация: 13.01.2010
Сообщения: 27
Репутация: 10
По умолчанию

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


Delphi Sources

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

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 17:22.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter