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 чел. читают эту тему (гостей: 2, скрытых пользователей: 0)
Пользователей: 0

 





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