Форум программистов, компьютерный форум, киберфорум
Наши страницы
Free Pascal
Войти
Регистрация
Восстановить пароль
 
LiveInDrive
0 / 0 / 0
Регистрация: 15.01.2012
Сообщений: 16
#1

Программа для рисования графиков - Free Pascal

14.01.2013, 20:05. Просмотров 380. Ответов 0
Метки нет (Все метки)

Нужно приспособить программу под данную формулу
f(x) = Sinx/1+Sin2x/2+SIn3x/3+Sin4x/4+Sin5x/5
Область определения [-10 ; 10].


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
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
Program Conrol;
Uses Graph, Crt;
Var BeginX, BeginY : LongInt; {экранные коорднаты начала и конца}
    mX, mY         : Real;{число натурльных единиц в 1 пикселе}
    Dx, Dy         : Real;{расстояние между делениями по осям в натур.ед.}
 
Procedure InitMyGraph;
var A, B : Integer;
 begin
  DetectGraph(A, B);
  InitGraph(A, B,' ');
 end;
 
Function Stepen(X : Real; N : LongInt) : Real;
var I : LongInt;
 begin
  Stepen:=1;
  for I:=1 to N do Stepen := Stepen*X;
 end;
 
 
 
 
Procedure Init;
 begin
  BeginX := GetMaxX div 2;
  BeginY := GetMaxY div 2;
  mX:=0.1/10;
  mY:=0.1/20;
  dX:=0.5;
  dY:=0.5;
 end;
 
Function XDispToXNat(X : LongInt) : Real;
 begin
  XDispToXNat := (X-BeginX)*mX;
 end;
 
Function YDispToYNat(Y : LongInt) : Real;
 begin
  YDispToYNat := (BeginY-Y)*mY;
 end;
 
Function XNatToXDisp(X : Real) : LongInt;
 begin
  XNatToXDisp:=Round(X/mX) + BeginX;
 end;
 
Function YNatToYDisp(Y : Real) : LongInt;
 begin
  YNatToYDisp := BeginY - Round(Y/mY);
 end;
 
 
Procedure DrawXY;
var A,X,Y,M     : Real;
    xD,xT,yT,yD : LongInt;
    S           : String;
 begin
  Line(0, BeginY, GetMaxX, beginY);
  Line(BeginX, 0, BeginX, GetMaxY);
  xD := XnatToXDisp(Dx) - beginX;
  yD := BeginY - YNatToYDisp(dY);
  xT := BeginX;
  yT := BeginY;
  OutTextXY(xT + 10, yT + 10, '0');
  while (xT<GetMaxX) do begin
                         xT := xT + xD;
                         Line(xT, yT + 3, xT, yT - 3);
                         M := XDispToXNat(xT);
                         Str(m:3:1, S);
                         OutTextXY(xT, yT + 10, S);
                        end;
 
  xT := BeginX;
  while (xT>-3) and (xT<=BeginX) do begin
                                     xT := xT - xD;
                                     Line(xT, yT + 3, xT, yT - 3);
                                     M := XDispToXNat(xT);
                                     Str(M:3:1, S);
                                     OutTextXY(xT, yT + 10, S);
                                    end;
  xT := BeginX;
 
  while (yt<getmaxy) do begin
                         yT := yT + yD;
                         Line(xT - 3, yT, xT + 3, yT);
                         M := YDispToYNat(yT);
                         Str(M:3:1, S);
                         OutTextXY(xT + 10, yT, S);
                        end;
 
  yT := BeginY - yD;
  while (yT>0) and (yT<BeginY) do begin
                                   Line(xT - 3, yT, xT + 3, yT);
                                   M := YDispToYNat(yT);
                                   Str(M:3:1, S);
                                   OutTextXY(xT + 10, yT, S);
                                   yT := yT - yD;
                                  end;
 end;
 
 
 
Function MyFunc(x:real):real;
var N       : LongInt;
    S, Next : Real;
 begin
  N:=1;
  Next:=1;
  S:=0;
  while Next>=0.000001 do begin
                           if (N mod 2 <> 0) and (N <> 1) then Next := (sin(N*X))/(N*(N+1))
                                                          else Next := (-1)*(sin(N*X))/(N*(N+1));
                           Inc(N);
                           S := S + Next;
                          end;
  MyFunc:=S;
 end;
 
 
Procedure DrawGraph;
var X, Y              : Real;
    N, X0, Y0, mX, mY : LongInt;
 begin
  SetColor(14);
  X:=-pi;
  while   X<=pi do begin
                    Y := MyFunc(X);
                    X0 := XNatToXDisp(X);
                    Y0 := YNatToYDisp(Y);
                    mX := XNatToXDisp(X);
                    mY := YNatToYDisp(MyFunc(X));
                    Line(X0,Y0,mX,mY);
                    X := X + 0.00001;
                   end;
 end;
 
Begin
 ClrScr;
 InitMyGraph;
 Init;
 DrawXY;
 DrawGraph;
 ReadLn;
End.
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
14.01.2013, 20:05
Я подобрал для вас темы с готовыми решениями и ответами на вопрос Программа для рисования графиков (Free Pascal):

Разобрать программу для рисования графиков функций от одной переменной
Народ, помогите пожалуйста! Надо создать универсальную программу для построения...

Составьте программу для рисования графика
Составьте программу для рисования графика функции:

Составить программу для произвольного рисования на экране
Составить программу для произвольного рисования на экране. Рисунок - это след...

При вводе ключей (для всех команд /?, для sort /r, для dir /o:s /a:-d /o:n) программа вылетает
Всем доброго времени суток, исправьте пжл ошибку в коде. program os_cmd;...

Программа для рисования графиков. Как поставить точку на форме/поле
Заранее благодарен)

программа рисования графиков
Всем доброго вечера! Задача такова.. Нужно написать программу рисования...

0
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
14.01.2013, 20:05
Привет! Вот еще темы с решениями:

Компонент для рисования графиков
Добрый день! Помогите найти библиотеку для рисования графиков с функцией...

Библиотека для рисования графиков по точкам
Существует необходимость по точкам построить графики с возможностью скролинга,...

Быстрый модуль для рисования графиков
Может кто порекомендовать достаточно быстрый модуль для создания графиков....

Технологии для рисования графиков на веб
Добрый день! У меня только первые шаги в графике для веб. Имеется ввиду не...


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

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

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