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


code warrior
****

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

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


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


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





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

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


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

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


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 
 К началу страницы 
+ Ответить 

Сообщений в этой теме


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

 





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