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

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

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

> Помогите с поворотом матрицы, Поворот матрицы
NeoSoft
сообщение 25.03.2006 17:40
Сообщение #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 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
NeoSoft
сообщение 27.03.2006 21:18
Сообщение #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 
 К началу страницы 
+ Ответить 

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


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

 



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