Pascal: создание двух графиков функций в одном окне

JGGraphExt.pas:

1. unit JGGraphExt;
2.  
3. interface
4.  
5. uses Graph,SysUtils;
6.  
7. type
8.   tFuncDoubleOfDouble=function(x:double): double;
9.   tAxis= (AxisX,AxisY);
10.   tWinSet= record
11.     i1,i2,j1,j2: integer;
12.     x1,x2,y1,y2: double
13.   end;
14.  
15. var
16.   WinSettings: tWinSet;
17.  
18.  
19. function WinX(x: double): integer;
20. function WinY(y: double): integer;
21. procedure WinLine(x1,y1,x2,y2: double);
22. procedure WinSet(u1,v1,u2,v2: double; a1,b1,a2,b2: integer);
23. procedure Axis(c: tAxis; t1,t2,t0,d: double; l,col: integer);
24. procedure PlotFunc(d,minX,maxX: double; c: integer; f: tFuncDoubleofDouble);
25. procedure Frame(c: integer);
26. procedure GrOn;
27. procedure GrOff;
28.  
29. implementation
30.  
31. procedure GrOn;
32. var
33.   gd,gm: integer;
34. begin
35.   gd:= detect;
36.   InitGraph(gd,gm,'')
37. end;
38.  
39.  
40. procedure GrOff;
41. begin
42.   CloseGraph
43. end;
44.  
45. function WinX(x: double): integer;
46. begin
47.   with WinSettings do WinX:= Round((x-x1)/(x2-x1)*(i2-i1))
48. end;
49.  
50.  
51. function WinY(y: double): integer;
52. begin
53.   with WinSettings do WinY:= j2-Round((y-y1)/(y2-y1)*(j2-j1))-j1
54. end;
55.  
56.  
57. procedure WinLine(x1,y1,x2,y2: double);
58. begin
59.   Line(WinX(x1),WinY(y1),WinX(x2),WinY(y2))
60. end;
61.  
62.  
63. procedure WinSet(u1,v1,u2,v2: double; a1,b1,a2,b2: integer);
64. begin
65.   with WinSettings do begin
66.     if a1<0 then i1:= GetMaxX+a1 else i1:= a1;
67.     if b1<0 then j1:= GetMaxY+b1 else j1:= b1;
68.     if a2<0 then i2:= GetMaxX+a2 else i2:= a2;
69.     if b2<0 then j2:= GetMaxY+b2 else j2:= b2;
70.     x1:= u1;
71.     y1:= v1;
72.     if u2<=u1 then x2:= x1+(v2-v1)/(j2-j1)*(i2-i1) else x2:= u2;
73.     if v2<=v1 then y2:= y1+(u2-u1)/(i2-i1)*(j2-j1) else y2:= v2;
74.     SetViewPort(i1,j1,i2,j2,true) // клиппинг
75.   end
76. end;
77.  
78.  
79. procedure Axis(c: tAxis; t1,t2,t0,d: double; l,col: integer);
80. var
81.   t: double; c0: integer;
82. begin
83.   with WinSettings do begin
84.     c0:= GetColor;
85.     SetColor(col);
86.     if c=AxisX then WinLine(t1,t0,t2,t0) else WinLine(t0,t1,t0,t2);
87.     t:= int((t1+d*0.1)/d)*d;
88.     while t<t2-d*0.1 do begin
89.       if c=AxisY then begin
90.         Line(WinX(t0)-l,WinY(t),WinX(t0)+l,WinY(t));
91.         OutTextXY(WinX(t0)+l*4,WinY(t)-3,FloatToStrF(t,ffFixed,5,2))
92.       end
93.       else begin
94.         Line(WinX(t),WinY(t0)-l,WinX(t),WinY(t0)+l);
95.         OutTextXY(WinX(t)-3,WinY(t0)+l*4,FloatToStrF(t,ffFixed,5,2))
96.       end;
97.       t:= t+d
98.     end;
99.     SetColor(c0)
100.   end
101. end;
102.  
103.  
104. procedure PlotFunc(d,minX,maxX: double; c: integer; f: tFuncDoubleofDouble);
105. var
106.   y: double; c0: integer;
107. begin
108.   with WinSettings do begin
109.     c0:= GetColor;
110.     Setcolor(c);
111.     y:= f(minX);
112.     MoveTo(WinX(minX),WinY(y));
113.     while minX<=maxX do begin
114.       y:= f(minX);
115.       LineTo(WinX(minX),WinY(y));
116.       minX:= minX+d
117.     end;
118.     SetColor(c0)
119.   end
120. end;
121.  
122. procedure Frame(c: integer);
123. var
124.   c0: integer;
125. begin
126.   c0:= Getcolor;
127.   Setcolor(c);
128.   with WinSettings do Rectangle(0,0,i2-i1,j2-j1);
129.   Setcolor(c0);
130. end;
131.  
132. begin
133. end.

test.pas:

1. uses
2.   WinCrt, Graph, SysUtils, JGGraphExt;
3.  
4.  
5. function YY(x: double): double;
6. begin
7.   YY:= x*(x*(x-5)-100)-100
8. end;
9.  
10.  
11. function Y_sin(x: double): double;
12. begin
13.   Y_sin:= 500*sin(x)*sin(x*x*x*x*x*x)
14. end;
15.  
16.  
17. begin
18.   GrOn;
19. // Plot_1
20.   WinSet(-20,-1000,20,1000,50,50,500,700);
21.   with WinSettings do begin
22.     Frame(lightGray);
23.     Axis(AxisX,x1,x2,300,10,2,LightGray);
24.     Axis(AxisY,y1,y2,0,200,2,LightGray);
25.     PlotFunc(0.1,x1,x2,LightGreen,@YY);
26.   end;
27. // Plot_2
28.   with WinSettings do begin
29.     WinSet(-20,-1000,20,1000,550,50,1300,700);
30.     Frame(lightGray);
31.     Axis(AxisX,x1,x2,300,10,2,LightGray);
32.     Axis(AxisY,y1,y2,0,200,2,LightGray);
33.     PlotFunc(0.1,x1,x2,blue,@Y_sin)
34.   end;
35.   ReadKey;
36.   GrOff
37. end.

Скачать download исходный код