IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

2 страниц V  1 2 >  
 Ответить  Открыть новую тему 
> Масштабирования растровых рисунков
Bokul
сообщение 22.08.2006 5:46
Сообщение #1


Гуру
*****

Группа: Пользователи
Сообщений: 1 117
Пол: Мужской
Реальное имя: Богдан

Репутация: -  11  +


Подскажите, пожалуйста, алгоритм масштабирования рисунков. Рисунок представляет собой двумерный массив, каждый елемент которого определяет цвет соответствующего пикселя на рисунке.

Сообщение отредактировано: Bokul - 22.08.2006 5:46


--------------------
Лао-Цзы :
Знать много и не выставлять себя знающим есть нравственная высота. Знать мало и выставлять себя знающим есть болезнь. Только понимая эту болезнь, мы можем избавиться от нее.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Bokul
сообщение 22.08.2006 7:46
Сообщение #2


Гуру
*****

Группа: Пользователи
Сообщений: 1 117
Пол: Мужской
Реальное имя: Богдан

Репутация: -  11  +


С увеличениям в целое количество раз я вроде разобрался.
Вот такую операцию надо проделивать для каждого елемента массива( каждой точки начального рисунка).
Код

for y:=1 to zoomy do
      for x:=1 to zoomx do
          putpixel(zoomx*(i-1)+x,zoomy*(j-1)+y,pict[i,j]);

zoomx - во сколько надо увеличить по оси x
zoomy - во сколько надо увеличить по оси y
pict - изначальный рисунок

Вот полная процедура для увеличения рисунка.
procedure pzoom;
var i,j,y,x:byte;
begin
for i:=1 to delt do
     for j:=1 to delt do
          for y:=1 to zoomy do
               for x:=1 to zoomx do
                    putpixel(zoomx*(i-1)+x,zoomy*(j-1)+y,pict[i,j]);
end;

delt - размерность рисунка

Кому интересно проверить процедуру, может скачать прикрепленный файл с примером массива (рисунка) для использования, delt=50.


Но пока еще не понятно как увеличивать и уменьшать рисунок в не целое количество раз. Пока на ум приходит только такое: чтобы увеличить, например, в 2.5 раза надо сначала увеличить его в 5 раз, а потом уменьшить в 2.
Вроде правильно, завтра попробую реализовать. Если у кого то есть замечания или предложения, буду рад если Вы ими поделитесь. rolleyes.gif

Сообщение отредактировано: volvo - 2.11.2006 13:29


Прикрепленные файлы
Прикрепленный файл  TEMP.pas ( 5.12 килобайт ) Кол-во скачиваний: 193
Прикрепленный файл  TEMP.pas ( 5.12 килобайт ) Кол-во скачиваний: 206


--------------------
Лао-Цзы :
Знать много и не выставлять себя знающим есть нравственная высота. Знать мало и выставлять себя знающим есть болезнь. Только понимая эту болезнь, мы можем избавиться от нее.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Бродяжник
сообщение 22.08.2006 8:22
Сообщение #3


Бывалый
***

Группа: Пользователи
Сообщений: 206
Пол: Мужской

Репутация: -  3  +


Копайте в сторону билинейной фильтрации. Кое-что можно найти.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
volvo
сообщение 22.08.2006 8:25
Сообщение #4


Гость






var
  zoomx, zoomy: real;

procedure pzoom;
var i,j,y,x:byte;
begin
  for i:=1 to delt do
    for j:=1 to delt do begin
      setfillstyle(solidfill, pict[i, j]);
      bar(trunc(zoomx*(i-1)), trunc(zoomy*(j-1)), trunc(zoomx*i-1), trunc(zoomy*j-1));
    end;
end;
 К началу страницы 
+ Ответить 
klem4
сообщение 22.08.2006 16:52
Сообщение #5


Perl. Just code it!
******

Группа: Модераторы
Сообщений: 4 100
Пол: Мужской
Реальное имя: Андрей

Репутация: -  44  +


Если конечно не обязательно работать с матрицой пикселов, то есть и стандартные методы изменение масштаба картинки, вот например :

uses WinCrt, Graph;


procedure GrInit;
var
  gd, gm, ge : integer;
begin

  gd := Detect;

  InitGraph(gd, gm, '');

  ge := GraphResult;

  if ge <> grOk then begin
    writeln('Graph Rrror : ', GraphErrorMsg(ge));
    readkey;
    Halt(1);
  end;

end;

procedure ScaleChange(scale : integer);
var
  A, B : Word;
begin
  GetAspectRatio(A, B);
  SetAspectRatio(A + scale, B + scale);
end;

procedure ShowImage;
begin
  Circle(GetMaxX div 2, GetMaxY div 2, 50);
end;

begin

  GrInit;

  ShowImage;

  Delay(2000); ScaleChange(-5000);  ClearDevice; ShowImage;
  Delay(2000); ScaleChange(+5000);  ClearDevice; ShowImage;

  readkey;

  CloseGraph;
  
end.


--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
volvo
сообщение 22.08.2006 17:18
Сообщение #6


Гость






klem4,
а не работает smile.gif Это во-первых.
Объясни мне, в чем разница в изображениях:
  ShowImage; readln; { <-- Здесь }

  Delay(2000); ScaleChange(+5000);  ClearDevice; ShowImage; readln; { <-- И здесь }



А во вторых, GetAspectRatio/SetAspectRatio меняют коэффициент сжатия изображения для всего экрана, а не для определенного его куска...
 К началу страницы 
+ Ответить 
klem4
сообщение 22.08.2006 17:23
Сообщение #7


Perl. Just code it!
******

Группа: Модераторы
Сообщений: 4 100
Пол: Мужской
Реальное имя: Андрей

Репутация: -  44  +


Цитата
Объясни мне, в чем разница в изображениях:


У тебя одно и тоже выводится ?


--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
volvo
сообщение 22.08.2006 17:35
Сообщение #8


Гость






Конечно... А ничего другого я и не ждал... Смотри:

  GetAspectRatio(A, B); { <--- Отношение высоты к ширине A/B = 10000/10000 = 1:1}
  SetAspectRatio(A + scale, B + scale); { <--- Установил отношение A/B = 15000/15000 = 1:1 }


Что должно измениться ? unsure.gif
 К началу страницы 
+ Ответить 
klem4
сообщение 22.08.2006 17:55
Сообщение #9


Perl. Just code it!
******

Группа: Модераторы
Сообщений: 4 100
Пол: Мужской
Реальное имя: Андрей

Репутация: -  44  +


blink.gif !fie.gif

И правда, соотношение то не меняется, но у меня картинка сначала увеличивается (расширяется) а потом приходит в начальное состояние.


--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Bokul
сообщение 23.08.2006 4:01
Сообщение #10


Гуру
*****

Группа: Пользователи
Сообщений: 1 117
Пол: Мужской
Реальное имя: Богдан

Репутация: -  11  +


Цитата

Копайте в сторону билинейной фильтрации. Кое-что можно найти.

А поподробнее можна? rolleyes.gif
volvo, спасибо, все отлично работает. good.gif
klem4, у меня появляется на несколько секунд круг и все...


--------------------
Лао-Цзы :
Знать много и не выставлять себя знающим есть нравственная высота. Знать мало и выставлять себя знающим есть болезнь. Только понимая эту болезнь, мы можем избавиться от нее.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
klem4
сообщение 23.08.2006 12:33
Сообщение #11


Perl. Just code it!
******

Группа: Модераторы
Сообщений: 4 100
Пол: Мужской
Реальное имя: Андрей

Репутация: -  44  +


Цитата
klem4, у меня появляется на несколько секунд круг и все...


По идее так и должно быть, не знаю почему у меня меняется smile.gif Можно исправить чтобы все было по уму, но я думаю действительно не стоит, ибо Volvo прав,
Цитата
GetAspectRatio/SetAspectRatio меняют коэффициент сжатия изображения для всего экрана, а не для определенного его куска...


Щас появилась одна идея, если сделаю покажу ;)


--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Бродяжник
сообщение 23.08.2006 14:35
Сообщение #12


Бывалый
***

Группа: Пользователи
Сообщений: 206
Пол: Мужской

Репутация: -  3  +


Bokul
Чтобы это объяснить поподробнее, мне надо самому вспомнить. Для этого надо полезть в Интернет, порыться там, вытащить пару документов...
Вкратце суть та, что, к примеру, увеличиваем рисунок в полтора раза. То есть из двух пикселов делаем три. Первый исходный пиксел переходит в первый выходной, один в один. Второй исходный - в третий выходной, один в один. Между ними надо вставить еще один пиксел. Так вот его цвет определяется, как усредненное значение между цветами соседних исходных пикселов. Что-то вроде этого. При этом, ясное дело, картинка слегка размывается. И в обратную сторону примерно то же самое. Если из двух пикселов делаем один, то его цвет усредняем.
Но об этом лучше почитать толковое описание, а не мои импровизации.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Archon
сообщение 23.08.2006 15:33
Сообщение #13


Профи
****

Группа: Пользователи
Сообщений: 618
Пол: Мужской

Репутация: -  24  +


Вот, что я нашёл в обучалках асфиксии. На аглицком наречии, но всё же довольно неплохо написано.
Цитата
For the horizontal area, I am going to calculate a certain step value. I
will then trace along the bitmap, adding this step to my position, and
placing the nearest pixel on to the screen. Let me explain this simpler ...

Let us say I have a 10 pixel wide bitmap. I want to squish it into 5 pixels.
Along the bitmap, I would draw every second pixel to screen. In ascii :

1234567890 13579
+--------+ +---+
| | | |
| bitmap | | |dest
| | | |
+--------+ +---+

As you can see, by stepping through every second pixel, I have shrunk the
bitmap to a width of 5 pixels.

The equation is as follows :

step = origionalwidth / wantedwidth;

Let us say we have a 100 pixel wide bitmap, which we want to get to 20 pixels.

step = 100 / 20
step = 5

If we draw every fifth pixel from the origional bitmap, we have scaled it down
correctly! This also works for all values, if step is of type real.

We also find the step for the height in the same way.

Our horizontal loop is as follows :

For loop1:=1 to wantedwidth do BEGIN
putpixel (loop1,height,bitmap[round (curpos)],vga);
curpos:=curpos+xstep;
END;

And the vertical loop is much the same. Easy huh?


--------------------
Close the World...txeN eht nepO
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
klem4
сообщение 24.08.2006 22:37
Сообщение #14


Perl. Just code it!
******

Группа: Модераторы
Сообщений: 4 100
Пол: Мужской
Реальное имя: Андрей

Репутация: -  44  +


Вот, реализовал свою идею smile.gif Грубовато конечно, до билинейной фильрации тут далеко :D

Управление W - увеличить, S - уменьшить

{$mode objfpc}

uses Crt, WinCrt, Graph;

type

  TCoordinate = LongInt;

const

  mx : TCoordinate = 0;
  my : TCoordinate = 0;
  cx : TCoordinate = 0;
  cy : TCoordinate = 0;

type

  TColor = 0..15;

  TInfo  = TColor;

  TRastr = array of array of TInfo;

  TImage = Object

    src, rslt : TRastr; // исходная и конечная матрицы

    sx, sy    : Integer; // размеры исходной матрицы

    x1, y1, x2, y2 : TCoordinate; // координаты захвата изображения

    zoom      : Integer; // текущее состояние картинки (0 - исходное состояние)

    constructor Init(x_1, y_1, x_2, y_2 : TCoordinate);
    destructor  Done;

    (*
      захват изображения,
      (x_1, y_1) - левая верхняя точка
      (x_2, y_2) - правая нижняя точка
    *)

    procedure GetSourceRastr; // заполнение исходной матрицы
    procedure GetResultRastr(up : boolean); // получение рузультирующей матрицы

    procedure ShowCentre;

  end;

constructor TImage.Init(x_1, y_1, x_2, y_2 : TCoordinate);
begin

  x1 := x_1;
  y1 := y_1;

  x2 := x_2;
  y2 := y_2;

  sx := x2 - x1 + 1;
  sy := y2 - y1 + 1;

  SetLength(src, sx, sy);

  zoom := 0;

end;

destructor TImage.Done;
begin
  SetLength(src, 0, 0);
  SetLength(rslt, 0, 0);
end;

procedure TImage.GetSourceRastr;
var
  x, y : TCoordinate;
begin

  for x := 0 to sx - 1 do
   for y := 0 to sy - 1 do
    src[x, y] := GetPixel(x + x1, y + y1);
end;

procedure TImage.GetResultRastr(up : boolean);
var
  x, y, rx, ry : TCoordinate;
  scale : integer;
begin

  case up of
    true  : scale := +2;
    false : scale := -2;
  end;

  if scale + zoom < 0 then exit; // уменьшить меньше исходного нельзя

  zoom := zoom + scale;

  if up then begin

    SetLength(rslt, sx * 2, sy * 2);

    for x := 0 to sx - 1 do
     for y := 0 to sx - 1 do
      for rx := 2 * x to 2 * x + 1 do
       for ry := 2 * y to 2 * y + 1 do
        rslt[rx, ry] := src[x, y];


    sx := sx * 2; 
    sy := sy * 2; 

    SetLength(src, 0, 0);
    SetLength(src, sx , sy);

    src := rslt;

  end else begin

    SetLength(rslt, sx div 2, sy div 2);

    x  := 0;
    rx := 0;

    while (x <= sx - 1) do begin

      y  := 0;
      ry := 0;

      while (y <= sy - 1) do begin
        rslt[rx, ry] := src[x, y];
        inc(y, 2);
        inc(ry);
      end;

      inc(x, 2);
      inc(rx);

    end;

    sx := sx div 2;
    sy := sy div 2;

    SetLength(src, 0, 0);
    SetLength(src, sx, sy);

    src := rslt;

  end;

end;

procedure TImage.ShowCentre;
var
  x, y : TCoordinate;
begin
  for x := 0 to sx - 1 do
   for y := 0 to sy - 1  do
    PutPixel(x + cx - sx div 2, y + cy - sy div 2, src[x, y]);
end;

procedure GrInit;
var
  gd, gm, ge : SmallInt;
begin

  gd := Detect;

  InitGraph(gd, gm, '');

  ge := GraphResult;

  if ge <> grOk then begin

    writeln('GraphError : ', GraphErrorMsg(ge));
    readkey;
    Halt(1);

  end;

  mx := GetMaxX;
  my := GetMaxY;

  cx := mx div 2;
  cy := my div 2;

end;

var

  Image : TImage;
  ch    : char;

begin

  clrscr;
  GrInit;

  // рисуем что-то ...

  SetFillStyle(1, BLUE);
  SetColor(RED);
  //Rectangle(cx - 10, cy - 10, cx + 10, cy + 10);
  Bar3D(cx - 10, cy - 10, cx + 10, cy + 10, 7, true);
  FloodFill(cx, cy, RED);
  SetColor(YELLOW);
  Circle(cx, cy, 5);

  // нарисовали

  Image.Init(cx - 50, cy - 50, cx + 50, cy + 50); // захватываем область

  Image.GetSourceRastr; // получаем исходную матирцу

  repeat

    ch := readkey;

    case ch of
      'w','W' : Image.GetResultRastr(true); // увеличение
      's','S' : Image.GetResultRastr(false); // уменьшение
    end;

    ClearDevice;

    Image.ShowCentre; // показвыаем

  until ch = #27;  // если ESC то выход

  Image.Done; 

  Readkey;

  CloseGraph;
end.


--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
volvo
сообщение 24.08.2006 23:16
Сообщение #15


Гость






blink.gif Я вот никак не могу понять, чего она так подтормаживает? Вроде же не такой большой объем вычислений... Я, конечно, знал, что динамические массивы медленнее статических, но не настолько же...
 К началу страницы 
+ Ответить 
klem4
сообщение 24.08.2006 23:18
Сообщение #16


Perl. Just code it!
******

Группа: Модераторы
Сообщений: 4 100
Пол: Мужской
Реальное имя: Андрей

Репутация: -  44  +


Думаю по тому, что картинка отображается попиксельно, хотя ... ? Возможно имеет смысл отрисовывать ее сначала на невидимой видеостранице, а потом работать с GetImage/PutImage ... Только увеличит ли это скорость smile.gif


добавлено : фактически результирующая матрица rslt вообще не нужна, можно в момент ее получения не запоминать элемент, а сразу отрисосвывть пиксел на невидимой странице, а потом запоминать все что получилось с помощью GetImage


--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
volvo
сообщение 24.08.2006 23:37
Сообщение #17


Гость






Ха... Да, ты прав... Это именно отрисовка тормозит, я уж грешным делом подумал, что сам пересчет...

Ан нет... Добавил к твоей программе ведение лога - все встало на свои места:


Прикрепленные файлы
Прикрепленный файл  log.txt ( 406 байт ) Кол-во скачиваний: 193
 К началу страницы 
+ Ответить 
Bokul
сообщение 24.08.2006 23:51
Сообщение #18


Гуру
*****

Группа: Пользователи
Сообщений: 1 117
Пол: Мужской
Реальное имя: Богдан

Репутация: -  11  +


klem4, не мог бы ты выложить файл с твоим кодом, а то при копировании все переносы строк исчезают?


--------------------
Лао-Цзы :
Знать много и не выставлять себя знающим есть нравственная высота. Знать мало и выставлять себя знающим есть болезнь. Только понимая эту болезнь, мы можем избавиться от нее.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
volvo
сообщение 25.08.2006 0:05
Сообщение #19


Гость






Кстати, вот так будет ГОРАЗДО быстрее (PutPixel - очень "дорогая" в смысле времени операция):
procedure TImage.ShowCentre;
var
  x, y : TCoordinate;
  csd_x, csd_y: TCoordinate;
begin
  csd_x := cx - sx div 2;
  csd_y := cy - sy div 2;

  for x := 0 to sx - 1 do
    for y := 0 to sy - 1  do
      if src[x, y] <> getbkcolor then { <--- Здесь !!! }
        PutPixel(x + csd_x, y + csd_y, src[x, y]);
end;
 К началу страницы 
+ Ответить 
klem4
сообщение 25.08.2006 9:15
Сообщение #20


Perl. Just code it!
******

Группа: Модераторы
Сообщений: 4 100
Пол: Мужской
Реальное имя: Андрей

Репутация: -  44  +


Bokul, держи


Прикрепленные файлы
Прикрепленный файл  SCALERELAEASE.pas ( 3.94 килобайт ) Кол-во скачиваний: 204


--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

2 страниц V  1 2 >
 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 

- Текстовая версия 31.07.2025 1:59
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"