Форум программистов, компьютерный форум, киберфорум
Наши страницы
Pascal ABC
Войти
Регистрация
Восстановить пароль
 
Рейтинг 5.00/9: Рейтинг темы: голосов - 9, средняя оценка - 5.00
Grisai
0 / 0 / 0
Регистрация: 08.12.2016
Сообщений: 10
1

Масштабирование

06.03.2017, 19:38. Просмотров 1688. Ответов 4
Метки нет (Все метки)

Задача вроде работает верно. Моя проблема в том, что не могу сделать масштабирование получившейся фигуры. Помогите с этой проблемой.

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Program N;
 
uses graphABC; 
 
var
   f: text;
   x, y, z, q: integer;
   name: string;
   
begin
 
   setwindowsize(700, 700);
   write('Название файла:'); readln(name);
   write(' ', name);
   Assign(f, name);
   writeln;
   reset(f);
   lockDrawing;
   
   while not Eof(f) do begin
      Readln(f, x, y, z, q);
      line(x, y, z, q);
      redraw;
      sleep(200);
   end;
   
   close(f); 
 
end.
0
QA
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
06.03.2017, 19:38
Ответы с готовыми решениями:

Добавить масштабирование
Народ кто может прикрутить сюда масштабирование? Program MAKKORM; var x0, x1, h, dx, dy, q, w:...

масштабирование picture
загружаю изображение..хочу чтобы оно постепенно увеличивалось..как это сделать?

Балансировка и масштабирование матриц
В общем тема не моя, а знакомая поиском и форумом не умеет пользоваться. Как я ее понял тема из...

Масштабирование рисунка на весь экран
Как сделать масштабирование произвольного рисунка на весь экран?

Превращение, масштабирование и поворота фигуры.
Помогите пожалуйста с этим заданием:нужно получить эту фигуру с помощью превращений,...

4
ZX Spectrum-128
Модератор
Эксперт Pascal/Delphi
4928 / 3451 / 4043
Регистрация: 05.06.2014
Сообщений: 17,334
06.03.2017, 19:39 2
Grisai, файл с фигурой нужно приложить.
0
Grisai
0 / 0 / 0
Регистрация: 08.12.2016
Сообщений: 10
06.03.2017, 19:46  [ТС] 3
Забыл)
0
Вложения
Тип файла: txt volume.txt (204 байт, 11 просмотров)
Grisai
0 / 0 / 0
Регистрация: 08.12.2016
Сообщений: 10
06.03.2017, 22:19  [ТС] 4
ZX Spectrum-128, сможете помочь с задачей?
0
Puporev
Модератор
57870 / 44077 / 30442
Регистрация: 18.05.2008
Сообщений: 105,462
07.03.2017, 09:45 5
Можно делать как афинные преобразования, темы с таким названием есть в разделе Паскаль, найдите и посмотрите, но мне кажется так вам будет понятнее.
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
uses graphABC,Events;
type point=record  //тип точка
           x,y:integer;//координаты
           end;
     otrez=record //тип отрезок
           a,b:point; //точки-кординаты концов
           ar,br,au,bu:real; //расстояеия до центра фигуры и углы лучей от + направления оси Х
           end;
var  k:real;//коэффициент массштабирования
     n,i:integer;//размер масива и счетчик циклов
     c:point; //точка-центр фигуры
     p:array[1..50] of otrez;//массив отрезков
//угол между лучем и осью Х
function Ugol(a,b:point):real;
begin
if (b.x>a.x)and(b.y<=a.y) then Ugol:=arctan((a.y-b.y)/(b.x-a.x)){I четверть}
else if (b.x>a.x)and(b.y>a.y) then Ugol:=arctan((a.y-b.y)/(b.x-a.x))+2*pi{IV четверть}
else if b.x<a.x then  Ugol:=arctan((a.y-b.y)/(b.x-a.x))+pi{II-III четверти}
else if b.x=a.x then
 begin
  if b.y<a.y then  Ugol:=pi/2//вертикально вверх
  else if b.y>a.y then Ugol:=3*pi/2//вертикально вниз
 end;
end;
//масштабирование
procedure KeyPress(Key:char);
begin
case Key of
'+':k:=k*1.1; //увеличение
'-':k:=k*0.9;//уменьшение
end;
clearwindow;
for i:=1 to n do
 begin
  p[i].ar:=p[i].ar*k;
  p[i].br:=p[i].br*k;
  p[i].a.x:=c.x+round(p[i].ar*cos(p[i].au));
  p[i].a.y:=c.y-round(p[i].ar*sin(p[i].au));
  p[i].b.x:=c.x+round(p[i].br*cos(p[i].bu));
  p[i].b.y:=c.y-round(p[i].br*sin(p[i].bu));
 end;
textout(windowwidth div 2-200,10,'Масштабировать + увеличение, - уменьшение');
for i:=1 to n do
line(p[i].a.x,p[i].a.y,p[i].b.x,p[i].b.y);
k:=1;
end;
 
var  f:text;
begin
assign(f,'volume.txt');
reset(f);
n:=0;
while not seekeof(f) do  //иселючает возможные пробелы в конце файла
 begin
  inc(n);
  Read(f,p[n].a.x,p[n].a.y,p[n].b.x,p[n].b.y);//читаем координаты в массив отрезков
 end;
close(f);
setwindowsize(700,700);
centerwindow; //окно в центр экрана
//найдем кординаты центра фигуры
c.x:=0;
c.y:=0;
for i:=1 to n do
 begin
  c.x:=c.x+p[i].a.x+p[i].b.x;
  c.y:=c.y+p[i].a.y+p[i].b.y;
 end;
c.x:=round(c.x/n/2);
c.y:=round(c.y/n/2);
//найдем радиусы и углы
for i:=1 to n do
 begin
  p[i].ar:=sqrt(sqr(c.x-p[i].a.x)+sqr(c.y-p[i].a.y));
  p[i].au:=Ugol(c,p[i].a);
  p[i].br:=sqrt(sqr(c.x-p[i].b.x)+sqr(c.y-p[i].b.y));
  p[i].bu:=Ugol(c,p[i].b);
 end;
setfontsize(12);
textout(windowwidth div 2-200,10,'Масштабировать:  + увеличение,  - уменьшение');
for i:=1 to n do
line(p[i].a.x,p[i].a.y,p[i].b.x,p[i].b.y);//рисуем отрезки
k:=1;
onkeypress:=KeyPress;
end.
Это для простого АВС, в NET модуль Events не нужен.
0
07.03.2017, 09:45
Answers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
07.03.2017, 09:45

Квадратичная функция (парабола) - масштабирование
Здравствуйте! Помогите пожалуйста поправить программу. Нужно чтобы при увеличение коэффициентов в...

Произвести элементарные действия с изображением: поворот, масштабирование, смещение
Необходимо произвести элементарные действия с изображением: поворот, масштабирование, смещение. Без...

масштабирование
Здоровья Вам!!! прошу помощи! вот делаю такую карту http://namore.biz.ua/karta в Мазиле...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
5
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2019, vBulletin Solutions, Inc.