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
сообщение 26.03.2006 19:57
Сообщение #2





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

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


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

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


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

 



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