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

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

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

 
 Ответить  Открыть новую тему 
> Помогите с поворотом матрицы, Поворот матрицы
сообщение
Сообщение #1





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

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


Помогите, пожалуйста. Программа рабочая, поворачивает,
но при отклонении от горизонтали и вертикали в изображении появляются дырки(некот. пиксели становятся черн. цвета), может это из-за округения координат... Может формулы неправильные, предложите свою идею поворота. Если кому надо UPCX могу выложить.

Program Rotate; 
Uses
CRT, Graph, UPCX; {UPCX - модуль для вывода на экран изображений *.PCX}

Const
Rad = Pi / 180; {1 Радиан}
PicX = 100; {Ширина}
PicY = 133; {Высота}

Type
Matrix = Array [0..PicX - 1, 0..PicY - 1] of Byte; {Картинка размером 100*133*256}

Var
GraphDriver, GraphMode : Integer;
Ang : Real; {Угол поворота}
Matrix1 : Matrix; {Картинка}
w, h : Integer; {Ширина, высота}

Procedure MakeArray(Var Matr : Matrix); {Создает массив}
Var
x,y : Word;
c : Byte; {Цвет}
Begin
For y:=0 to PicY - 1 do
Begin
For x:=0 to PicX - 1 do
Begin
c := GetPixel(x, y);
Matr[x, y] := c; {Запись цвета c в массив Matr}
End;
End;
End;

Procedure ShowArray(Matr : Matrix; w,h : Word); {Показать массив}
Var
x,y : Word;
c : Byte;
Begin
For y:=0 to PicY - 1 do
Begin
For x:=0 to PicX - 1 do
Begin
c := Matr[x,y];
PutPixel(x+w, y+h, c);
End;
End;
End;

Procedure DrawMatrix; {Осуществляет поворот(стырел на форуме)}
Var
i, j : Integer;
x2, y2 : Real;
Begin
For i := 0 to PicY - 1 do
Begin
For j := 0 to PicX - 1 do
Begin
x2 := w + i * cos(ang * rad) - j * sin(ang * rad);
y2 := h + i * sin(ang * rad) + j * cos(ang * rad);
PutPixel(Round(x2), Round(y2), Matrix1[j,i]);
End;
End;
End;

Begin
GraphDriver := InstallUserDriver('BGI256', nil);
GraphMode := 3;
{0 - 320*200*256
1 - 640*400*256
2 - 640*480*256
3 - 800*600*256
4 - 1024*768*256
5 - 2048*1024*256}
InitGraph(GraphDriver, GraphMode, ''{Смотрит в текущем каталоге});
ReadPCXfile('PCX\mama.pcx',0,0); {Выводит изображение на экран}
MakeArray(Matrix1); {Создает массив(матрицу)}
Ang := 0; {Начальный угол поворота}
Repeat
h := 300;
w := h;
DrawMatrix; {Поворот}
Ang := Ang + 1; {Счетчик}
If (Ang > 360) Then Ang := 0; {Проверка угла}
ClearDevice; {Чистка экрана(из-за нее возможно так тормозит)}
Until KeyPressed;
CloseGraph;
End.


Помогите...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Лихорадка неясного генеза.
**

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

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


А какже 5-е правило радела(чуть выше твоего поста smile.gif )???

Почувствуй себя модератором ? Флейм, флуд и оффтоп преследуется по закону.

Сообщение отредактировано: klem4 -


--------------------
Мир промышленного программирования полон избыточной сложности. В результате такие критерии, как простота, надежность, компактность программ и эффективность исполняемого кода, теперь заменяются на один главный критерий — скорость реализации идей. Приоритет времени разработки понятен: человеческие ресурсы нынче стоят значительно выше, чем аппаратные. Но не теряем ли мы по дороге то ценное, что вернуть потом будет крайне тяжело?..
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


code warrior
****

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

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


Попробуй "дырки" интерполировать.
Кроме того ты ДЛЯ КАЖДОГО пикселя считаешь синусы и косинусы! этож жуть как долго, посчитай 1 раз и - скорость раза в 2-3 возрастёт.


--------------------
ИзВ ин ИтЕ зА нЕ рОв НЫй П оч ЕРк
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4





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

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


Цитата(hardcase @ 25.03.2006 20:50) *

Попробуй "дырки" интерполировать.
Кроме того ты ДЛЯ КАЖДОГО пикселя считаешь синусы и косинусы! этож жуть как долго, посчитай 1 раз и - скорость раза в 2-3 возрастёт.
Спасибо за идею, но я новичок в программировании не мог бы ты код написАть. Или объяснить поподробнее (попонятнее).
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


code warrior
****

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

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


Цитата(NeoSoft @ 25.03.2006 21:42) *
Спасибо за идею, но я новичок в программировании не мог бы ты код написАть. Или объяснить поподробнее (попонятнее).

Вот для ускорения расчётов:
Procedure DrawMatrix; {Осуществляет поворот(стырел на форуме)} 
Var
i, j : Integer;
x2, y2 : Real;
sin_, cos_: Real;
Begin
sin_:=sin(ang * rad);
cos_:=cos(ang * rad);
For i := 0 to PicY - 1 do
Begin
For j := 0 to PicX - 1 do
Begin
x2 := w + i * cos_ - j * sin_;
y2 := h + i * sin_ + j * cos_;
PutPixel(Round(x2), Round(y2), Matrix1[j,i]);
End;
End;
End;

Об интерполяции: я так думаю, можно фиксировать, какие пиксеми мы заполнили, а какие не заполнили - заполнять цветом, который является средним между цветами соседних пикселей. Но для этого предётся держать массив PicX x PicY булевых величин, что не очень хорошо... кажется был ещё какой-то вариант заполнения.


--------------------
ИзВ ин ИтЕ зА нЕ рОв НЫй П оч ЕРк
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6





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

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


Цитата(hardcase @ 25.03.2006 22:53) *

Вот для ускорения расчётов:

...

Об интерполяции: я так думаю, можно фиксировать, какие пиксеми мы заполнили, а какие не заполнили - заполнять цветом, который является средним между цветами соседних пикселей. Но для этого предётся держать массив PicX x PicY булевых величин, что не очень хорошо... кажется был ещё какой-то вариант заполнения.
Спасибо за код и идею с интерполяцией good.gif : идею, суть уловил, попробую реализовать(Наверняка не получится).
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7





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

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


А нет ли другого изначально более качественного способа поворта изображения (матрицы), чтоб точки не поправлять???
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8





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

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


Procedure DrawMatrix; {Осуществляет поворот}
Var
i, j : Integer;
x2, y2 : Real;
sin_, cos_ : Real;
Begin
sin_ := sin(Ang * Rad);
cos_ := cos(Ang * Rad);
For i := 0 to PicY - 1 do
Begin
For j := 0 to PicX - 1 do
Begin
x2 := i * cos_ - j * sin_;
y2 := i * sin_ + j * cos_;
PutPixel(w + i, h + j, Matrix1[Round(y2), Round(x2)]);
{PutPixel(Round(x2), Round(y2), Matrix1[j,i]);}
End;
End;
End;


Вопрос решён наполовину: изображение вертится, пустот в изображении нет (хотя качество страдает), но изображение выводится на экран в прямоугольнике, судя по всему H x W, и куча пикселей летает в дали от изображения, но в прямоугольнике...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Профи
****

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

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


Расширь границы прямоуголиника (цифры от балды):
  For i := -166 to 166 do  Begin 
For j := -166 to 166 do begin


Добавь проверку:
 if (y2<PicY) and (y2>=0) and (x2<PicX) and (x2>=0) then
PutPixel(w + i, h + j, Matrix1[Round(y2), Round(x2)]);
else
PutPixel(w + i, h + j, 0);
End;
End;
End;
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10


code warrior
****

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

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


Думаю, можно ещё так поступить (основная идея):
Анализировать, на какие пиксели попадает наша повёрнутая точка и в соответствии с этим ставить на них цвет в зависимости от площади, занимаемой этим кусочком повёрнутого пикселя. В случае, когда пиксель, на который мы бросаем цвет, уже окрашен мы просто смешиваем эти цвета - т.о. получится антиальязинг и будут дырки закрыты.


--------------------
ИзВ ин ИтЕ зА нЕ рОв НЫй П оч ЕРк
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #11





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

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


Program Rotate; { Программа поворота изображения на произвольный угол }
Uses
CRT, Graph, UPCX; { UPCX - модуль для вывода на экран изображений *.PCX }
Const
Rad = Pi / 180; { 1 Радиан }
PicX = 100; { Ширина }
PicY = 133; { Высота }
Diag = 167; { Diag := Round(Sqrt(Sqr(PicX) + Sqr(PicY))); }
Type
TMatrix = Array [0..PicX - 1, 0..PicY - 1] of Byte; { Картинка размером PicX*PicY*256 }
PMatrix = ^TMatrix; { Указатель на массив }
Var
GraphDriver, GraphMode : Integer;
Ang : Real; { Угол поворота }
Matrix : PMatrix; { Картинка }
w, h : Integer; { Ширина, высота }
Procedure MakeArray(Var Matr : PMatrix); { Создает массив }
Var
x, y : Word;
c : Byte; { Цвет }
Begin
For y := 0 to PicY - 1 do
Begin
For x := 0 to PicX - 1 do
Begin
c := GetPixel(x, y); { Сканирование цвета точки }
Matr^[x, y] := c; { Запись цвета c в массив Matr }
End;
End;
ClearDevice; { Чистка экрана }
End;
Procedure DrawMatrix(Matr : PMatrix; Angle : Real); { Осуществляет поворот }
Var
i, j : Integer;
x2, y2 : Real;
sin_, cos_ : Real;
Begin
sin_ := sin(Angle * Rad); { Вычисление синуса }
cos_ := cos(Angle * Rad); { Вычисление косинуса }
For i := -Diag to Diag - 1 do
Begin
For j := -Diag to Diag - 1 do
Begin
x2 := j * cos_ - i * sin_; { Повернутые }
y2 := j * sin_ + i * cos_; { координаты }
{ Проверка: не вылезли ли пиксели за пределы картинки, если нет, то: ... }
if (y2 < PicY) and (y2 >= 0) and (x2 < PicX) and (x2 >= 0) then
{ Поиск точки в массиве и прорисовка ее на экран }
PutPixel(w + j, h + i, Matr^[Round(x2), Round(y2)])
{ если да, то: ... }
else
PutPixel(w + j, h + i, 0); { Ставим точку черного цвета (цвета фона) }
End;
End;
End;

Begin
GraphDriver := InstallUserDriver('BGI256', nil); { Установка граф. режима }
GraphMode := 3;
{ 0 - 320*200*256
1 - 640*400*256
2 - 640*480*256
3 - 800*600*256
4 - 1024*768*256
5 - 2048*1024*256 }
InitGraph(GraphDriver, GraphMode, ''{ Смотрит в текущем каталоге });
ReadPCXfile('PCX\mama.pcx',0,0); { Выводит изображение на экран }
New(Matrix); { Выделение динамич. памяти }
MakeArray(Matrix); { Создает массив(матрицу) }
Ang := 0; { Начальный угол поворота }
h := 300; { Отступ по-вертикали }
w := h; { Отступ по-горизонтали }
Repeat
DrawMatrix(Matrix, Ang); { Поворот }
Ang := Ang + 1; { Счетчик }
If (Ang > 360) Then Ang := 0; { Проверка угла }
Until KeyPressed;
Dispose(Matrix); { Освобождение памяти }
CloseGraph;
End.
Вот так всё работает good.gif
Только всё ОЧЕНЬ МЕДЛЕННО работает norespect.gif
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #12


Профи
****

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

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


Цитата(NeoSoft @ 27.03.2006 21:18) *

Вот так всё работает good.gif
Только всё ОЧЕНЬ МЕДЛЕННО работает norespect.gif

Совсем не обязательно поворачивать каждую точку, поверни только 4 крайние и посчитай dx,dy по строке и dx,dy по высоте. Тогда в цикле можно x2 и y2 считать через сложение с предыдущей точкой. Должно быть быстрее.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 





- Текстовая версия 30.04.2024 15:55
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name