Форум программистов, компьютерный форум, киберфорум
Наши страницы
С++ для начинающих
Войти
Регистрация
Восстановить пароль
 
fennix
0 / 0 / 0
Регистрация: 04.11.2016
Сообщений: 14
#1

Затруднения с запуском программы в среде Турбо Паскаль

18.11.2016, 10:05. Просмотров 105. Ответов 1
Метки нет (Все метки)

{Eto bolsoi modul' risovanija grafikov i poverkhnostei.}
unit GRAPHIC;
interface
uses graph, crt;
type massiv=array [1..10000] of real;
pmas=^massiv;
dinmas=array [1..8] of pmas;
func=function(x:real):real;
func1=function(x,y:real):real;
PROCEDURE GRAFIK (a, b:real; n: integer; fun:ARRAY OF FUNC;
x1, y1, x2, y2: word; Colors: array of WORD; var Err:shortint);
{Procedura risovanija grafikov vos'mi funktsiy v odnoi sisteme koordinat. }
{a,b - interval, na kotorom risujutsja grafiki, n - kolichestvo grafikov (n<=8).
fun1 ,...,fun8 - imena izobrazhaemikh funktsij.}
{x1, y1, x2, y2 - prjamougolnik na ekrane,
vnutri kotorogo budut izobrazhatsja grafiki.}
{Colors - massiv tsvetov. }
{Colors [0] - tsviet fona.}
{Colors [1] - tsviet pervogo grafika.}
{Colors [2] - tsviet vtorogo grafika.}
...
...
{Colors [8] - tsviet vos'jmogo grafika.}
{Colors [9] - tsviet ramki i podpisei.}
{Err - kod oshibki.}
{0 - normal'noe zavershenie programmi.
-1 - n>8 or n<1,
-2 - x1,y1<0 or x2,y2>getmaxX, getmaxY, }
PROCEDURE GRAFIK1 (n:integer; m:integer; xmas;y:dinmas;
x1,y1,x2,y2:word;Colors: array of WORD; var Err:shortint);
{Protsedura risovanija vos'jmi grafikov funktsij po tochkam v odnoi sisteme koordinat.}
{a,b - intrerval, na kotorom risujutsja grafiki.}
{m - kolichestvo tochek v massivakh x, y.}
{n - kolichestvo grafikov (n<=8).}
{x - dinamicheskij massiv x (ukazatel').}
{y - massiv ukazatelej y.}
{x1, y1, x2, y2 - prjamougolnik na ekrane, vnutri kotorogo budut
izobrazhatsja grafiki.}
{Colors - massiv tsvietov.}
{Colors[0] - tsviet fona.}
{Colors[1] - tsviet pervogo grafika.}
{Colors[2] - tsviet vtorogo grafika.}
...
{Colors[8] - tsviet vos'jmogo grafika.}
{Colors[9] - tsviet ramki i podpisei.}
{Err - kod oshibki.}
{0 - normal'noe zavershenie programmi.}
{-1 - n>8 or n<1.}
{-2 - x1,y1<0 or x2,y2>getmaxX,getmaxY.}
Procedure surfase(xMin,xMax,yMin, yMax, Rad, Theta, Phi, D:real;
fun:func1);
{Protsedura risovanija grafika dvumernoi funktsii Z=F(X,Y).}
{fun - funktsija f(x,y).}
{xmin,xmax,ymin,ymax - granitsi izmenenija peremennikh x i y.}
{d - rasstojanie do krivoi.}
{rad,theta,phi - tri ugla v radianakh.}
implementation
PROCEDURE GRAFIK(a,b:real; n:integer; fun:ARRAY OF FUNC;
x1,y1,x2,y2:word;Colors:array of WORD; var Err:shortint);
var
xmas;
y:dinmas;
rx,ty,ymax,ymin,a1,b1,c1,d1:real;
kol,y1n,y2n,x1n,x2n,k,dx,i,j,nmax,nmin:integer;
s:string[10];
begin
if (n<1) or (n>8) then
begin
Err:=-1;
if (x1<0) or (y1<0) or (x2>getmaxX) or (y2>GetmaxY) then
begin
Err:=-2
exit
end;
{ Ustanavlivaetsja tsviet fona. }
SetBkColor(Colors[0]);
{ Ustanavlivaetsja tsviet linij i teksta. }
SetColor(Colors[9]);
dx:=x2-x1;
dy:=y2-y1;
x1n:=x1+trunc(dx/10);
x2n:=x2-trunc(dx/20);
y1n:=y1+trunc(dy/10);
y2n:=y2-trunc(dy/10);
kol:=x2n-x1n;
{ Videlenie pamjati pod dinamicheskiy massiv X. }
getmen(x,(kol+1)*6);
{ Formirovanie massiva X. }
x^[1]:=a;
for i:=2 to kol+1 do
x^[i]:=x^[i-1]+(b-a)/kol;
{ Videlenie pamjati pod dinamicheskiy massiv Y. }
for i:=1 to n do
GetMen(y[i],(kol+1)*6);
{ Zapis' v massiv Y znachenij funktsij. }
for i:=1 to kol+1 do
begin
y[1]^[i]:=fun[0](x^[i]);
if n>=2 then y[2]^[i]:=fun[1](x^[i]);
if n>=3 then y[3]^[i]:=fun[2](x^[i]);
if n>=4 then y[4]^[i]:=fun[3](x^[i]);
if n>=5 then y[5]^[i]:=fun[4](x^[i]);
if n>=6 then y[6]^[i]:=fun[5](x^[i]);
if n>=7 then y[7]^[i]:=fun[6](x^[i]);
if n>=8 then y[8]^[i]:=fun[7](x^[i])
end;
{ Poisk maksimuma i minimuma v massive Y. }
ymin:=y[1]^[1];
ymax:=y[1]^[1];
nmin:=1;
nmax:=1;
for j:=1 to n do
for i:=1 to kol+1 do
begin
if y[j]^[i]>ymax then
begin
ymax:=y[j]^[i];
nmax:=i;
end;
if y[j]^[i]<ymIN then
begin
ymin:=y[j]^[i];
nmin:=i;
end
end;
{ Formirovanie koeffitsientov perescheta v "ekrannuju" sistemu koordinat. }
a1:=(x2n-x1n)/(b-a);
b1:=x1n-a1*a;
c1:=(y1n-y2n)/(ymax-ymin);
d1:=y2n-c1*ymin;
{ Risovanie osei i podpisi. }
rx:=(x2n-x1n-1)/5;
ry:=(y2n-y1n+1)/5;
line(x1n-1,y2n+1,x2n+trunc(0.0375*dx),y2n+1);
str(x^[1]:1:2,s);
settextjustify(0,1);
outtextxy(x1n-25,y2n+1+trunc(dy/20),s);
str(x^[kol+1]:1:2,s);
settextjustify(2,1);
outtextxy(x1n+5*trunc(rx)+25,y2n+1+trunc(dy/20),s);
for i:=1 to 5 do
begin
line(x1n+1+i*trunc(rx),y2n+1-trunc(dy/50),x1n+1+i*trunc(rx),y2n+1);
line(x1n+1+i*trunc(rx),y2n+1,x1n+1+i*trunc(rx),y1n);
end;
line(x1n-1,y2n+1,x1n-1,y1n-trunc(0.075*dy));
str(ymin:1:2,s);
settextjustify(2,1);
outtextxy(x1n-trunc(dx/200),y2n+1-trunc(dy/50)+10,s);
str(ymax:1:2,s);
settextjustify(2,1);
outtextxy(x1n-trunc(dx/200),y1n+trunc(dy/50)-10,s);
for i:=1 to 5 do
begin
line(x1n+1+trunc(dx/100),y2n-1-i*trunc(ry),x1n,y2n-1-i*trunc(ry));
line(x2n,y2n-1-i*trunc(ry),x1n,y2n-1-i*trunc(ry));
end;
line(x2n+trunc(0.0375*dx),y2n+1,
x2n+trunc(0.0375*dx)-trunc(dx/50),trunc(y2n+1+dy/200));
line(x2n+trunc(0.0375*dx),y2n+1,
x2n+trunc(0.0375*dx)-trunc(dx/50),trunc(y2n+1-dy/200));
line(x1n-1,y1n-trunc(0.075*dy),x1n-1+trunc(dx/120),
y1n-trunc(0.075*dy)+trunc(dy/50));
line(x1n-1,y1n-trunc(0.075*dy),x1n-1-trunc(dx/120),
y1n-trunc(0.075*dy)+trunc(dy/50));
{ Risovanie grafikov neprerivnikh funktsij. }
for j:=1 to n do
begin
SetColor(Colors[j]);
for i:=1 to kol do
line(trunc(a1*x^[i]+b1),trunc(c1*y[j]^[i]+d1),
trunc(a1*x^[i+1]+b1),trunc(c1*y[j]^[i+1]+d1))
end;
{ Osvobozhdenie pamjati. }
FreeMen(x,(kol+1)*6);
for i:=1 to n do
FreeMen(y[i],(kol+1)*6)
end;
PROCEDURE GRAFIK1(n:integer;m:integer; xmas;y:dinmas;
x1,y1,x2,y2:word;Colors:array of WORD; var Err:shortint);
var
a,b:real;
rx,ry,ymax,ymin,a1,b1,c1,d1:real;
kol,y1n,y2n,x1n,x2n,k,dx,dy,i,j,nmax,nmin:integer;
s:string[10];
begin
a:=x^[1];
b:=x^[m];
if (n<1) or (n>8) then
begin
Err:=-1;
exit
end;
if(x1<0) or (y1<0) or (x2>getmaxX) or (y2>GetmaxY) then
begin
Err:=-2;
exit
end;
SetColor(Colors[9]);
dx:=x2-x1;
dy:=y2-y1;
x1n:=x1+trunc(dx/10);
x2n:=x2-trunc(dx/20);
y1n:=y1+trunc(dy/10);
y2n:=y2-trunc(dy/10);
kol:=m;
ymin:=y[1]^[1];
ymax:=y[1]^[1];
nmin:=1;
nmax:=1;
for j:=1 to n do
for i:=1 to kol do
begin
if y[j]^[i]>ymax then
begin
ymax:=y[j]^[i];
nmax:=i;
end;
if y[j]^[i]<ymin then
begin
ymin:=y[j]^[i];
nmin:=i;
end
end;
a1:=(x2n-x1n)/(b-a);
b1:=x1n-a1*a;
c1:=(y1n-y2n)/(ymax-ymin);
d1:=y2n-c1*ymin;
rx:=(x2n-x1n-1)/5;
ry:=(y2n-y1n+1)/5;
line(x1n-1,y2n+1,x2n+trunc(0.0375*dx),y2n+1);
str(x^[1]:1:2,s);
settextjustify(0,1);
outtxtxy(x1n-25,y2n+1+trunc(dy/20),s);
str(x^[kol]:1:2,s);
settextjustify(2,1);
outtextxy(x1n+5*trunc(rx)+25,y2n+1+trunc(dy/20),s);
for i:=1 to 5 do
line(x1n+1+i*trunc(rx),y2n-1,x1n+1+i*trunc(rx),y1n);
line(x1n-1,y2n-1,x1n-1,y1n-trunc(0.075*dy));
str(ymin:1:2, s);
settextjustify(2,1);
outtextxy(x1n-trunc(dx/200),y2n+1-trunc(dy/50),s);
str(ymax:1:2, s);
settextjustify(2,1);
outtextxy(x1n-trunc(dx/200),y1n+trunc(dy/50),s);
for i:=1 to 5 do
line(x2n,y2n-1-i*trunc(ry),x1n,y2n-1-i*trunc(ry));
line(x2n+trunc(0.0375*dx),y2n+1,
x2n+trunc(0.0375*dx)-trunc(dx/50),trunc(y2n+1+dy/200));
line(x2n+trunc(0.0375*dx),y2n+1,
x2n+trunc(0.0375*dx)-trunc(dx/50),trunc(y2n+1-dy/200));
line(x1n-1,y1n-trunc(0.075*dy),x1n-1+trunc(dx/120),
y1n-trunc(0.075*dy)+trunc(dy/50));
line(x1n-1,y1n-trunc(0.075*dy),x1n-1-trunc(dx/120),
y1n-trunc(0.075*dy)+trunc(dy/50));
for j:=1 to n do
begin
SetColor(Colors[j]);
for i:=1 to kol-1 do
line(trunc(a1*x^[i]+b1),trunc(c1*y[j]^[i]+d1),
trunc(a1*x^[i+1]+b1),trunc(c1*y[j]^[i+1]+d1))
end;
end;
Procedure surface (xMin,xMax,yMin,yMax,Rad,Theta,Phi,D:real; fun:func1);
var
x,y,dx,dy,Ax,Ay,Bx,By:real;
dxMax,dxMin,dyMax,dyMin:real;
xStep,yStep:real;
i,j,xCount,yCount:integer;
xNew,yNew,xOld,yOld:integer;
Show:boolean;
const
Big=9.999999E+10;
Margin=0.1;
procedure FindEyeCoordinates(x,y:real; var dx,dy:real;
Theta,Phi,Rad,D:real);
var
z,xx,yy,zz:real;
begin
z:=Fun(z,y);
xx:=-x*sin(Theta)++y*cos(Theta);
yy:=-x*cos(Theta)*cos(Phi)-y*sin(Theta)*cos(Phi)+z*sin(Phi);
zz:=-x*cos(Theta)*sin(Phi)-y*sin(Theta)*sin(Phi)-z*cos(Phi)+Rad;
dx:=D*xx/zz;
dy:=D*yy/zz
end;
procedure FindScreenCoordinates(Ax,Ay,Bx,By,dx,dy:real;
var xNew,yNew:integer);
begin
xNew:=trunc(Ax+Bx*dx);
yNew:=GetMaxY-trunc(Ay+By*dy)
end;
procedure FindLimits(dx,dy:real;var dxMax,dxMin,dyMax,dyMin:real);
begin
if dx>dxMax then dxMax:=dx;
if dx<dxMin then dxMin:=dx;
if dy>dyMax then dyMax:=dy;
if dy<dyMin then dyMin:=dy;
end;
procedure FindWindow (dxMax,dxMin,dyMax,dyMin:real; var
Ax,Ay,Bx,By:real);
var
xSize,ySize:real;
begin
xSize:=dxMax-dxMin;
ySize:=dyMax-dyMin;
dxMin:=dxMin-Margin*xSize;
dyMin:=dyMin-Margin*ySize;
dxMax:=dxMax+Margin*xSize;
dyMax:=dyMax+Margin*ySize;
Bx:=GetMaxX/(dxMax-dxMin);
By:=GetMaxY/(dyMax-dyMin);
Ax:=-dxMin*Bx;
Ay:=-dyMin*By
end;
begin
xCount:=20;
yCount:=20;
line(0,0,GetMaxX,0);
line(GetMaxX,GetMaxY,0,GetMaxY);
line(0,0,0,GetMaxY);
line(GetMaxX,0,GetMaxX,GetMaxY);
xStep:=(xMax-xMin)/xCount;
yStep:=(yMax-yMin)/yCount;
dxMin:=Big;
dxMax:=-Big;
dyMin:=Big;
dyMax:=-Big;
for Show:=false to true do
begin
for i:=0 to xCount do
begin
x:=xMin+i*xStep;
y:=yMin;
FindEyeCoordinates(x,y,dx,dy,Theta,Phi,Rad,D);
if Show then
begin
FindScreenCoordinates(Ax,Ay,Bx,By,dx,dy,xNew,yNew);
xOld:=xNew;
yOld:=yNew;
MoveTo(xOld,yOld)
End
else FindLimits(dx,dy,dxMax,dxMin,dyMax,dyMin);
for j:=0 to yCount do
begin
y:=yMin+j*yStep;
FindEyeCoordinates(x,y,dx,dy,Theta,Phi,Rad,D);
if Show then
begin
FindScreenCoordinates(Ax,Ay,Bx,By,dx,dy,xNew,yNew);
lineTo (xNew,yNew);
xOld:=xNew;
yOld:=yNew
end
else FindLimits(dx,dy,dxMax,dxMin,dyMin,dyMax,dyMin)
end
end;
if not Show then FindWindow(dxMax, dxMin, dyMax, dyMin, Ax, Ay,
Bx, By)
end;
for i:=0 to yCount do
Begin
y:=yMin+i*yStep;
x:=xMin;
FindEyeCoordinates(x,y,dx,dy,Theta,Phi,Rad,D);
if show then
begin
FindScreenCoordinates(Ax,Ay,Bx,By,dx,dy,xNew,yNew);
xOld:=xNew;
yOld:=yNew;
moveTo(xOld,yOld);
end
else
FindLimits(dx,dx,dxMax,dxMin,dyMax,dyMin);
for j:=0 to xCount do
begin
x:=xMin+j*xStep;
FindEyeCoordinates(x,y,dx,dy,Theta,Phi,Rad,D);
if Show then
begin
FindScreenCoordinates(Ax,Ay,Bx,By,dx,dy,xNew,yNew);
LineTo(xNew,yNew);
xOld:=xNew;
yOld:=yNew
end
else
FindLimits(dx,dy,dxMax,dxMin,dyMax,dyMin)
end
end;
repeat until KeyPressed;
end;
end.
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
18.11.2016, 10:05
Ответы с готовыми решениями:

простые программы в среде Турбо Си++
1.Вводятся два произвольных числа A и B. Вывести на экран, одинаковые у них...

Затруднения в составлении программы с условными операторами
Здраствуйте! Нужна помощь в составлении программы согласно инструкции. Дело...

Затруднения в составлении программы с условными операторами if.else.switch
Здравствуйте! Нужна ваша помощь в составлении программы с условными операторами...

Цикл while. Затруднения с составления программы с простым алгоритмом и проверкой подлинности
Здравствуйте, подскажите пожалуйста, у меня в ответе получается 34.75. Как...

Вывод изображения перед запуском программы
Здравствуйте. Интересует следующий вопрос: Как вывести изображение(логотип)...

1
fennix
0 / 0 / 0
Регистрация: 04.11.2016
Сообщений: 14
18.11.2016, 10:07  [ТС] #2
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
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
{Eto bolsoi modul' risovanija grafikov i poverkhnostei.}
unit GRAPHIC;
interface
uses graph, crt;
type massiv=array [1..10000] of real;
  pmas=^massiv;
  dinmas=array [1..8] of pmas;
  func=function(x:real):real;
  func1=function(x,y:real):real;
PROCEDURE GRAFIK (a, b:real; n: integer; fun:ARRAY OF FUNC;
x1, y1, x2, y2: word; Colors: array of WORD; var Err:shortint);
{Procedura risovanija grafikov vos'mi funktsiy v odnoi sisteme koordinat. }
{a,b - interval, na kotorom risujutsja grafiki, n - kolichestvo grafikov (n<=8).
fun1 ,...,fun8 - imena izobrazhaemikh funktsij.}
{x1, y1, x2, y2 - prjamougolnik na ekrane,
vnutri kotorogo budut izobrazhatsja grafiki.}
{Colors - massiv tsvetov. }
{Colors [0] - tsviet fona.}
{Colors [1] - tsviet pervogo grafika.}
{Colors [2] - tsviet vtorogo grafika.}
...
...
{Colors [8] - tsviet vos'jmogo grafika.}
{Colors [9] - tsviet ramki i podpisei.}
{Err - kod oshibki.}
{0 - normal'noe zavershenie programmi.
-1 - n>8 or n<1,
-2 - x1,y1<0 or x2,y2>getmaxX, getmaxY, }
PROCEDURE GRAFIK1 (n:integer; m:integer; x:pmas;y:dinmas;
x1,y1,x2,y2:word;Colors: array of WORD; var Err:shortint);
{Protsedura risovanija vos'jmi grafikov funktsij po tochkam v odnoi sisteme koordinat.}
{a,b - intrerval, na kotorom risujutsja grafiki.}
{m - kolichestvo tochek v massivakh x, y.}
{n - kolichestvo grafikov (n<=8).}
{x - dinamicheskij massiv x (ukazatel').}
{y - massiv ukazatelej y.}
{x1, y1, x2, y2 - prjamougolnik na ekrane, vnutri kotorogo budut
izobrazhatsja grafiki.}
{Colors - massiv tsvietov.}
{Colors[0] - tsviet fona.}
{Colors[1] - tsviet pervogo grafika.}
{Colors[2] - tsviet vtorogo grafika.}
...
{Colors[8] - tsviet vos'jmogo grafika.}
{Colors[9] - tsviet ramki i podpisei.}
{Err - kod oshibki.}
{0 - normal'noe zavershenie programmi.}
{-1 - n>8 or n<1.}
{-2 - x1,y1<0 or x2,y2>getmaxX,getmaxY.}
Procedure surfase(xMin,xMax,yMin, yMax, Rad, Theta, Phi, D:real;
fun:func1);
{Protsedura risovanija grafika dvumernoi funktsii Z=F(X,Y).}
{fun - funktsija f(x,y).}
{xmin,xmax,ymin,ymax - granitsi izmenenija peremennikh x i y.}
{d - rasstojanie do krivoi.}
{rad,theta,phi - tri ugla v radianakh.}
implementation
PROCEDURE GRAFIK(a,b:real; n:integer; fun:ARRAY OF FUNC;
  x1,y1,x2,y2:word;Colors:array of WORD; var Err:shortint);
var
  x:pmas;
  y:dinmas;
  rx,ty,ymax,ymin,a1,b1,c1,d1:real;
  kol,y1n,y2n,x1n,x2n,k,dx,i,j,nmax,nmin:integer;
  s:string[10];
begin
  if (n<1) or (n>8) then
  begin
     Err:=-1;
     if (x1<0) or (y1<0) or (x2>getmaxX) or (y2>GetmaxY) then
  begin
     Err:=-2
     exit
  end;
{ Ustanavlivaetsja tsviet fona. }
  SetBkColor(Colors[0]);
{ Ustanavlivaetsja tsviet linij i teksta. }
  SetColor(Colors[9]);
  dx:=x2-x1;
  dy:=y2-y1;
  x1n:=x1+trunc(dx/10);
  x2n:=x2-trunc(dx/20);
  y1n:=y1+trunc(dy/10);
  y2n:=y2-trunc(dy/10);
  kol:=x2n-x1n;
{ Videlenie pamjati pod dinamicheskiy massiv X. }
  getmen(x,(kol+1)*6);
{ Formirovanie massiva X. }
  x^[1]:=a;
  for i:=2 to kol+1 do
  x^[i]:=x^[i-1]+(b-a)/kol;
{ Videlenie pamjati pod dinamicheskiy massiv Y. }
  for i:=1 to n do
   GetMen(y[i],(kol+1)*6);
{ Zapis' v massiv Y znachenij funktsij. }
  for i:=1 to kol+1 do
  begin
     y[1]^[i]:=fun[0](x^[i]);
     if n>=2 then y[2]^[i]:=fun[1](x^[i]);
     if n>=3 then y[3]^[i]:=fun[2](x^[i]);
     if n>=4 then y[4]^[i]:=fun[3](x^[i]);
     if n>=5 then y[5]^[i]:=fun[4](x^[i]);
     if n>=6 then y[6]^[i]:=fun[5](x^[i]);
     if n>=7 then y[7]^[i]:=fun[6](x^[i]);
     if n>=8 then y[8]^[i]:=fun[7](x^[i])
  end;
{ Poisk maksimuma i minimuma v massive Y. }
ymin:=y[1]^[1];
ymax:=y[1]^[1];
nmin:=1;
nmax:=1;
for j:=1 to n do
   for i:=1 to kol+1 do
   begin
      if y[j]^[i]>ymax then
      begin
         ymax:=y[j]^[i];
         nmax:=i;
      end;
      if y[j]^[i]<ymIN then
      begin
         ymin:=y[j]^[i];
         nmin:=i;
      end
   end;
{ Formirovanie koeffitsientov perescheta v "ekrannuju" sistemu koordinat. }
 a1:=(x2n-x1n)/(b-a);
 b1:=x1n-a1*a;
 c1:=(y1n-y2n)/(ymax-ymin);
 d1:=y2n-c1*ymin;
{ Risovanie osei i podpisi. }
 rx:=(x2n-x1n-1)/5;
 ry:=(y2n-y1n+1)/5;
 line(x1n-1,y2n+1,x2n+trunc(0.0375*dx),y2n+1);
 str(x^[1]:1:2,s);
 settextjustify(0,1);
 outtextxy(x1n-25,y2n+1+trunc(dy/20),s);
 str(x^[kol+1]:1:2,s);
 settextjustify(2,1);
 outtextxy(x1n+5*trunc(rx)+25,y2n+1+trunc(dy/20),s);
 for i:=1 to 5 do
 begin
    line(x1n+1+i*trunc(rx),y2n+1-trunc(dy/50),x1n+1+i*trunc(rx),y2n+1);
    line(x1n+1+i*trunc(rx),y2n+1,x1n+1+i*trunc(rx),y1n);
 end;
 line(x1n-1,y2n+1,x1n-1,y1n-trunc(0.075*dy));
 str(ymin:1:2,s);
 settextjustify(2,1);
 outtextxy(x1n-trunc(dx/200),y2n+1-trunc(dy/50)+10,s);
 str(ymax:1:2,s);
 settextjustify(2,1);
 outtextxy(x1n-trunc(dx/200),y1n+trunc(dy/50)-10,s);
 for i:=1 to 5 do
 begin
    line(x1n+1+trunc(dx/100),y2n-1-i*trunc(ry),x1n,y2n-1-i*trunc(ry));
    line(x2n,y2n-1-i*trunc(ry),x1n,y2n-1-i*trunc(ry));
 end;
 line(x2n+trunc(0.0375*dx),y2n+1,
 x2n+trunc(0.0375*dx)-trunc(dx/50),trunc(y2n+1+dy/200));
 line(x2n+trunc(0.0375*dx),y2n+1,
 x2n+trunc(0.0375*dx)-trunc(dx/50),trunc(y2n+1-dy/200));
 line(x1n-1,y1n-trunc(0.075*dy),x1n-1+trunc(dx/120),
 y1n-trunc(0.075*dy)+trunc(dy/50));
 line(x1n-1,y1n-trunc(0.075*dy),x1n-1-trunc(dx/120),
 y1n-trunc(0.075*dy)+trunc(dy/50));
{ Risovanie grafikov neprerivnikh funktsij. }
 for j:=1 to n do
 begin
    SetColor(Colors[j]);
    for i:=1 to kol do
        line(trunc(a1*x^[i]+b1),trunc(c1*y[j]^[i]+d1),
    trunc(a1*x^[i+1]+b1),trunc(c1*y[j]^[i+1]+d1))
 end;
{ Osvobozhdenie pamjati. }
 FreeMen(x,(kol+1)*6);
 for i:=1 to n do
    FreeMen(y[i],(kol+1)*6)
 end;
 PROCEDURE GRAFIK1(n:integer;m:integer; x:pmas;y:dinmas;
   x1,y1,x2,y2:word;Colors:array of WORD; var Err:shortint);
 var
   a,b:real;
   rx,ry,ymax,ymin,a1,b1,c1,d1:real;
   kol,y1n,y2n,x1n,x2n,k,dx,dy,i,j,nmax,nmin:integer;
   s:string[10];
 begin
   a:=x^[1];
   b:=x^[m];
   if (n<1) or (n>8) then
   begin
      Err:=-1;
      exit
   end;
   if(x1<0) or (y1<0) or (x2>getmaxX) or (y2>GetmaxY) then
   begin
      Err:=-2;
      exit
   end;
   SetColor(Colors[9]);
   dx:=x2-x1;
   dy:=y2-y1;
   x1n:=x1+trunc(dx/10);
   x2n:=x2-trunc(dx/20);
   y1n:=y1+trunc(dy/10);
   y2n:=y2-trunc(dy/10);
   kol:=m;
   ymin:=y[1]^[1];
   ymax:=y[1]^[1];
   nmin:=1;
   nmax:=1;
   for j:=1 to n do
     for i:=1 to kol do
     begin
        if y[j]^[i]>ymax then
        begin
           ymax:=y[j]^[i];
           nmax:=i;
        end;
        if y[j]^[i]<ymin then
        begin
           ymin:=y[j]^[i];
           nmin:=i;
        end
     end;
   a1:=(x2n-x1n)/(b-a);
   b1:=x1n-a1*a;
   c1:=(y1n-y2n)/(ymax-ymin);
   d1:=y2n-c1*ymin;
   rx:=(x2n-x1n-1)/5;
   ry:=(y2n-y1n+1)/5;
   line(x1n-1,y2n+1,x2n+trunc(0.0375*dx),y2n+1);
   str(x^[1]:1:2,s);
   settextjustify(0,1);
   outtxtxy(x1n-25,y2n+1+trunc(dy/20),s);
   str(x^[kol]:1:2,s);
   settextjustify(2,1);
   outtextxy(x1n+5*trunc(rx)+25,y2n+1+trunc(dy/20),s);
   for i:=1 to 5 do
     line(x1n+1+i*trunc(rx),y2n-1,x1n+1+i*trunc(rx),y1n);
   line(x1n-1,y2n-1,x1n-1,y1n-trunc(0.075*dy));
   str(ymin:1:2, s);
   settextjustify(2,1);
   outtextxy(x1n-trunc(dx/200),y2n+1-trunc(dy/50),s);
   str(ymax:1:2, s);
   settextjustify(2,1);
   outtextxy(x1n-trunc(dx/200),y1n+trunc(dy/50),s);
   for i:=1 to 5 do
     line(x2n,y2n-1-i*trunc(ry),x1n,y2n-1-i*trunc(ry));
   line(x2n+trunc(0.0375*dx),y2n+1,
   x2n+trunc(0.0375*dx)-trunc(dx/50),trunc(y2n+1+dy/200));
   line(x2n+trunc(0.0375*dx),y2n+1,
   x2n+trunc(0.0375*dx)-trunc(dx/50),trunc(y2n+1-dy/200));
   line(x1n-1,y1n-trunc(0.075*dy),x1n-1+trunc(dx/120),
   y1n-trunc(0.075*dy)+trunc(dy/50));
   line(x1n-1,y1n-trunc(0.075*dy),x1n-1-trunc(dx/120),
   y1n-trunc(0.075*dy)+trunc(dy/50));
   for j:=1 to n do
   begin
      SetColor(Colors[j]);
      for i:=1 to kol-1 do
         line(trunc(a1*x^[i]+b1),trunc(c1*y[j]^[i]+d1),
      trunc(a1*x^[i+1]+b1),trunc(c1*y[j]^[i+1]+d1))
   end;
 end;
 Procedure surface (xMin,xMax,yMin,yMax,Rad,Theta,Phi,D:real; fun:func1);
 var
   x,y,dx,dy,Ax,Ay,Bx,By:real;
   dxMax,dxMin,dyMax,dyMin:real;
   xStep,yStep:real;
   i,j,xCount,yCount:integer;
   xNew,yNew,xOld,yOld:integer;
   Show:boolean;
 const
   Big=9.999999E+10;
   Margin=0.1;
 procedure FindEyeCoordinates(x,y:real; var dx,dy:real;
    Theta,Phi,Rad,D:real);
 var
   z,xx,yy,zz:real;
 begin
   z:=Fun(z,y);
   xx:=-x*sin(Theta)++y*cos(Theta);
   yy:=-x*cos(Theta)*cos(Phi)-y*sin(Theta)*cos(Phi)+z*sin(Phi);
   zz:=-x*cos(Theta)*sin(Phi)-y*sin(Theta)*sin(Phi)-z*cos(Phi)+Rad;
   dx:=D*xx/zz;
   dy:=D*yy/zz
 end;
 procedure FindScreenCoordinates(Ax,Ay,Bx,By,dx,dy:real;
 var xNew,yNew:integer);
 begin
   xNew:=trunc(Ax+Bx*dx);
   yNew:=GetMaxY-trunc(Ay+By*dy)
 end;
 procedure FindLimits(dx,dy:real;var dxMax,dxMin,dyMax,dyMin:real);
 begin
   if dx>dxMax then dxMax:=dx;
   if dx<dxMin then dxMin:=dx;
   if dy>dyMax then dyMax:=dy;
   if dy<dyMin then dyMin:=dy;
 end;
 procedure FindWindow (dxMax,dxMin,dyMax,dyMin:real; var
 Ax,Ay,Bx,By:real);
 var
   xSize,ySize:real;
 begin
   xSize:=dxMax-dxMin;
   ySize:=dyMax-dyMin;
   dxMin:=dxMin-Margin*xSize;
   dyMin:=dyMin-Margin*ySize;
   dxMax:=dxMax+Margin*xSize;
   dyMax:=dyMax+Margin*ySize;
   Bx:=GetMaxX/(dxMax-dxMin);
   By:=GetMaxY/(dyMax-dyMin);
   Ax:=-dxMin*Bx;
   Ay:=-dyMin*By
 end;
 begin
   xCount:=20;
   yCount:=20;
   line(0,0,GetMaxX,0);
   line(GetMaxX,GetMaxY,0,GetMaxY);
   line(0,0,0,GetMaxY);
   line(GetMaxX,0,GetMaxX,GetMaxY);
   xStep:=(xMax-xMin)/xCount;
   yStep:=(yMax-yMin)/yCount;
   dxMin:=Big;
   dxMax:=-Big;
   dyMin:=Big;
   dyMax:=-Big;
   for Show:=false to true do
   begin
      for i:=0 to xCount do
      begin
         x:=xMin+i*xStep;
         y:=yMin;
         FindEyeCoordinates(x,y,dx,dy,Theta,Phi,Rad,D);
         if Show then
         begin
            FindScreenCoordinates(Ax,Ay,Bx,By,dx,dy,xNew,yNew);
            xOld:=xNew;
            yOld:=yNew;
            MoveTo(xOld,yOld)
         End
         else FindLimits(dx,dy,dxMax,dxMin,dyMax,dyMin);
            for j:=0 to yCount do
            begin
               y:=yMin+j*yStep;
                 FindEyeCoordinates(x,y,dx,dy,Theta,Phi,Rad,D);
               if Show then
               begin
               FindScreenCoordinates(Ax,Ay,Bx,By,dx,dy,xNew,yNew);
               lineTo (xNew,yNew);
               xOld:=xNew;
            yOld:=yNew
               end
            else FindLimits(dx,dy,dxMax,dxMin,dyMin,dyMax,dyMin)
            end
         end;
            if not Show then FindWindow(dxMax, dxMin, dyMax, dyMin, Ax, Ay,
Bx, By)
     end;
     for i:=0 to yCount do
     Begin
        y:=yMin+i*yStep;
        x:=xMin;
        FindEyeCoordinates(x,y,dx,dy,Theta,Phi,Rad,D);
        if show then
        begin
           FindScreenCoordinates(Ax,Ay,Bx,By,dx,dy,xNew,yNew);
           xOld:=xNew;
           yOld:=yNew;
           moveTo(xOld,yOld);
        end
        else
           FindLimits(dx,dx,dxMax,dxMin,dyMax,dyMin);
           for j:=0 to xCount do
           begin
              x:=xMin+j*xStep;
              FindEyeCoordinates(x,y,dx,dy,Theta,Phi,Rad,D);
              if Show then
              begin
                 FindScreenCoordinates(Ax,Ay,Bx,By,dx,dy,xNew,yNew);
                 LineTo(xNew,yNew);
                 xOld:=xNew;
                 yOld:=yNew
              end
              else
              FindLimits(dx,dy,dxMax,dxMin,dyMax,dyMin)
           end
        end;
        repeat until KeyPressed;
    end;
end.
Добавлено через 57 секунд
При написании программы в среде Турбо Паскаль 7.0 возникают задержки курсора, клавиатура перестает "слушаться", не реагирует на ввод символов, либо же "каретка" начинает уезжать в сторону, после перехода на новое окно нажатием клавиш Alt+Tab работа нормализуется.
При запуске программы "GRAPH_AN.PAS" в компиляторе возникает ошибка: "Error 15: File not found (GRAPH.TPU)."

Версия компилятора: Turbo Pascal 7 for Windows7-8-8.1 by TechApple.Net, с поддержкой полноэкранного режима в системе Windows 7.

Издание Windows: Windows 7 Максимальная (С) Корпорация Майкрософт (Microsoft Corp.), 2009. Все права защищены.
Service Pack1

Система:
модель: ASUSTeK K52N
Процессор: AMD V140 Processor 2.30 GHz
Установленная память (ОЗУ): 2.0 ГБ (1.75 ГБ доступно)
Тип системы: 32-разрядная операционная система

Помогите пожалуйста решить данную проблему
0
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
18.11.2016, 10:07

Создание и использование DLL, Трудности с запуском программы
В Задании имеется образец программы, не знаю как запустить чтобы работал...

В какой среде пишут программы на С++
подскажите как написать программу на этой среде и как выщая математика нужна...

Программы с графическим интерфейсом в среде wxDev
Помогите пожалуйста решить задачу(или подкинте какой-нить литературы по теме),...


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

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

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