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





Группа: Пользователи
Сообщений: 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 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Профи
****

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

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


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

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

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

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


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

 





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