Advertisement
daniv1

Untitled

Mar 3rd, 2018
123
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 8.88 KB | None | 0 0
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  9.   StdCtrls, Spin;
  10.  
  11. type
  12.      Vector = array [0..10000] of Real; // для створення масивів із координатами графіків
  13. Vec = array [0..50] of Real; // для створення масивів із коефіцієнтами ряду Фур’є
  14.   { TForm1 }
  15.  
  16.   TForm1 = class(TForm)
  17.     Button1: TButton;
  18.     Button2: TButton;
  19.     Edit1: TEdit;
  20.     Edit2: TEdit;
  21.     Edit3: TEdit;
  22.     Edit4: TEdit;
  23.     GroupBox1: TGroupBox;
  24.     Image1: TImage;
  25.     Label1: TLabel;
  26.     Label10: TLabel;
  27.     Label11: TLabel;
  28.     Label2: TLabel;
  29.     Label3: TLabel;
  30.     Label5: TLabel;
  31.     Label6: TLabel;
  32.     Label7: TLabel;
  33.     Label8: TLabel;
  34.     Label9: TLabel;
  35.     SpinEdit1: TSpinEdit;
  36.     SpinEdit2: TSpinEdit;
  37.     SpinEdit3: TSpinEdit;
  38.     SpinEdit4: TSpinEdit;
  39.     procedure Button1Click(Sender: TObject);
  40.     procedure Button2Click(Sender: TObject);
  41.     procedure Edit3Change(Sender: TObject);
  42.     procedure Image1Click(Sender: TObject);
  43.   private
  44.                                  //
  45.   public                       //   2= k * 3 + b
  46.                                //
  47.   end;
  48.  
  49. var
  50.   Form1: TForm1;
  51.   Xe, Ye : Vector; // Масиви для зберігання координат нашої періодичної функції
  52. Xg, Yg : Vector; // Масиви для зберігання координат протабульованого ряду Фур'є
  53. a, b, c : Vec;// Масиви для зберігання коефіцієнтів ряду Фур'є
  54. Ne, Ngr, Ng : Integer; // Ne = Ngr кількість точок обох графіків
  55. al, bl, Tp : Real; // Область визначення функції та її період : Tp = bl – al
  56. implementation
  57.  
  58. {$R *.lfm}
  59.   Function f(x : Real) : Real; // Опис нашої періодичної функції
  60. Begin
  61.  
  62. Tp := bl - al;
  63. if x < TP / 2 then
  64. f:= (2*(-x+tp/2)) / (tp/2)  else
  65. f:= (2*(x - tp/2))/ (tp/2) ;
  66. end;
  67. Procedure TabF(var Xe: Vector; var Ye: Vector);// Процедура табулювання періодичної функції
  68. Var h : Real;
  69. i : Integer;
  70. Begin
  71. h := (bl - al) / Ne;
  72. Xe[0]:= al;
  73. For i := 0 to Ne - 1 do
  74. Begin
  75. Ye[i] := f(Xe[i]) ;
  76. Xe[i+1] := Xe[i] + h;
  77. End;
  78. End;
  79. // Процедура побудови і табулювання ряду Фур’є згідно з алгоритмом, що є на рис. 4.
  80. Procedure Furje(Xe, Ye : Vector; Ne : Integer; var Yg : Vector);
  81. Var i, k : Integer;
  82. w, KOM, S, G, D : Real;
  83. Begin
  84. Ng := StrToInt(Form1.Edit2.text); // Вводимо кількість гармонік
  85. TP := bl - al; // TP – період нашої функції
  86. // Обчислення коефіцієнтів ряду Фур'є
  87. w := 2 * Pi / TP;
  88. For k := 1 to Ng do
  89. Begin
  90. KOM := k * w;
  91. G := 0.0;
  92. D := 0.0;
  93. For i :=1 to Ne do
  94. Begin
  95. S := KOM * Xe[i];
  96. G := G + Ye[i] * Cos(S);
  97. D := D + Ye[i] * Sin(S);
  98. End;
  99. a[k] := 2 * G / Ne;
  100. b[k] := 2 * D / Ne;
  101. c[k] := Sqrt(Sqr(a[k]) + Sqr(b[k]));
  102. End;
  103. a[0] := 0.0;
  104. For i := 1 to Ne do
  105. a[0] := a[0] + Ye[i];
  106. a[0] := a[0] / Ne;
  107. For i := 0 to Ne - 1 do // Побудова і табулювання суми ряду Фур’є
  108. Begin
  109. S := 0;
  110. D := Xe[i] * w;
  111. For k:=1 to Ng do
  112. Begin
  113. KOM := k * D;
  114. S := S + b[k] * Sin(KOM) + a[k] * Cos(KOM);
  115. End;
  116. Yg[i] := a[0] + S;
  117. End;
  118. End;
  119. { TForm1 }
  120.  
  121. procedure TForm1.Image1Click(Sender: TObject);
  122. begin
  123.  
  124. end;
  125.  
  126. procedure TForm1.Button1Click(Sender: TObject);
  127. Var p,zx,zy,ay,bx,krx,kry,xx,yy,Gx,Gy : Real;
  128. i,j,krokx,kroky,drv,drm,visx,visy : Integer;
  129. l:Integer;
  130. minYg,maxYg,maxx,maxy,minx,miny,kx,ky:real;
  131.   Procedure Garm(Ng : Integer; c:Vec);
  132. Var i , Krokx, x : Integer;
  133. MaxC, Ky, W : Real;
  134. Begin
  135. Krokx := (Image1.ClientWidth - 2 * L) div Ng;
  136. MaxC := c[1];
  137. For I := 2 to Ng do
  138. If c[i] > MaxC then MaxC := c[i];
  139. Ky := (Image1.ClientHeight div 2) / MaxC;
  140. With Image1.Canvas do
  141. Begin
  142. Pen.Color := clHighlight;
  143. Pen.Width := 2;
  144. MoveTo(L, L + 20 );
  145. LineTo(L + 10, L + 10);
  146. LineTo(L + 20, L + 20);
  147. MoveTo(L + 10, L + 10);
  148. LineTo(L + 10, Image1.ClientHeight - 50);
  149. LineTo(Image1.ClientWidth-20, Image1.ClientHeight-50);
  150. MoveTo(Image1.ClientWidth-40, Image1.ClientHeight-60);
  151. LineTo(Image1.ClientWidth-20, Image1.ClientHeight-50);
  152. LineTo(Image1.ClientWidth-40, Image1.ClientHeight-40);
  153. TextOut(L - 2, L ,'C');
  154. TextOut(ClientWidth - 50, ClientHeight - 25 ,'W');
  155. Pen.Color := clFuchsia;
  156. Pen.Width := 2;
  157. x := KrokX + 20;
  158. w := 2 * Pi /(bl - al);
  159. For i:= 1 to Ng do
  160. Begin
  161. MoveTo(Round(x)+3,Image1.ClientHeight-50);
  162. LineTo(Round(x)+3,Image1.ClientHeight-50-Round(ky*c[i]));
  163. TextOut(round(x),Image1.ClientHeight - Round(ky*c[i])-65, FloatToStrF(c[i],ffGeneral,0,0));
  164. Ellipse(round(x),Image1.ClientHeight-53,round(x)+5,Image1.ClientHeight-48);
  165. Ellipse(Round(x)+1,Image1.ClientHeight-50-Round(ky*c[i]),Round(x)+7,
  166. Image1.ClientHeight-50-Round(ky*c[i])+5);
  167. x := x + KrokX;
  168. End;
  169. x := KrokX + 19;
  170. TextOut(round(x),Image1.ClientHeight - 30,'W='+FloatToStrF(w,ffGeneral,0,0));
  171. End;
  172. End;
  173. // Процедура візуалізації гармонік
  174. begin
  175.  
  176.  
  177. // Початок виконуваної частини процедури TForm1.Button1Click
  178. Begin
  179. Ne := StrToInt(Edit1.Text);
  180. Ngr:= Ne;
  181. al := StrToFloat(Form1.Edit3.Text);
  182. bl := StrToFloat(Form1.Edit4.Text);
  183. TabF( Xe, Ye); // Табулюємо задану нами періодичну функцію
  184. Furje(Xe,Ye,Ne,Yg); // Обчислюємо коефіцієнти ряду Фур'є і табулюємо суму ряду
  185. // Будуємо графіки обох функцій Ye(Xe) та Yg(Xe)
  186. L:=40; // Відступ від країв компоненти TImage
  187. With Form1.Image1 do
  188. Begin
  189. Canvas.Pen.Width := 2;
  190. Canvas.Pen.Color := clBlue;
  191. Canvas.Pen.Style := psSolid;
  192. Canvas.Rectangle(1, 1, Width - 1, Height - 1);
  193. MinYg:=Yg[0]; MaxYg:=Yg[0];
  194. For i := 1 to Ngr - 1 do
  195. Begin
  196. If MaxYg < Yg[i] then MaxYg := Yg[i];
  197. If MinYg > Yg[i] then MinYg := Yg[i];
  198. End;
  199. MinX := Xe[0]; MaxX := Xe[Ne-1];
  200. MinY := Ye[0]; MaxY := Ye[0];
  201. For i := 1 to Ne - 1 do
  202. Begin
  203. If MaxY< Ye[i] then MaxY := Ye[i];
  204. If MinY> Ye[i] then MinY := Ye[i];
  205. End;
  206. If MaxY < MaxYg then MaxY := MaxYg;
  207. If MinY > MinYg then MinY := MinYg;
  208. // Обчислюємо зачення коефіцієнтів масштабування
  209. Kx := (Width - 2 * L) /(MaxX - MinX);
  210. Ky := (Height - 2 * L) /(MinY - MaxY);
  211. Zx := (Width * MinX - L * (MinX + MaxX)) / (MinX - MaxX);
  212. Zy := (Height * MaxY - L * (MinY + MaxY)) / (MaxY - MinY);
  213. End;
  214. // Обчислюємо розташування плаваючих осей
  215. If MinX * MaxX <= 0.0 then Gx := 0.0;
  216. If (MinX * MaxX > 0.0) then Gx := MinX;
  217. If (MinX * MaxX > 0.0) then Gx := MinX;
  218. If (MinX * MaxX > 0.0) and (MinX < 0.0) then Gx := MaxX;
  219. If MinY * MaxY <= 0.0 then Gy := 0.0;
  220. If (MinY * MaxY > 0.0) and (MinY > 0.0) then Gy := MinY;
  221. If (MinY * MaxY > 0.0) and (MinY < 0.0) then Gy := MaxY;
  222. With Form1.Image1.Canvas do // ------------------------
  223. Begin
  224. Pen.Color := clSilver;
  225. Pen.Width := SpinEdit3.Value;
  226. KrokX := (Width - 2 * L) div 10;
  227. KrokY := (Height - 2 * L) div 10;
  228. For i := 0 to 10 do
  229. Begin
  230. MoveTo(L, Round(Ky * Gy + Zy) + i * KrokY);
  231. LineTo(Width - L, Round(Ky * Gy + Zy) + i * KrokY);
  232. MoveTo(L, Round(Ky * Gy + Zy) - i * KrokY);
  233. LineTo(Width - L, Round(Ky * Gy + Zy) - i * KrokY);
  234. MoveTo(Round(Kx * Gx + Zx) + i * KrokX,L);
  235. LineTo(Round(Kx * Gx + Zx) + i * KrokX, Height - L);
  236. MoveTo(Round(Kx * Gx + Zx) - i * KrokX, L);
  237. LineTo(Round(Kx * Gx + Zx) - i * KrokX, Height - L);
  238. End;
  239. // Виведення підписів осей координат---------------------------------
  240. xx := MinX; yy := MaxY;
  241. KrX := (MaxX - MinX) / 10.0;
  242. KrY := (MaxY - MinY) / 10.0;
  243. For i:=0 to 9 do
  244. Begin
  245. TextOut(L + 4 + i * KrokX,
  246. Round(Ky * Gy + Zy) - L + 43,
  247. FloatToStrF(XX, ffGeneral, 2, 5));
  248. TextOut(Round(Kx*Gx+Zx)-L+10,
  249. L + i * KrokY - 5,
  250. FloatToStrF(YY, ffGeneral, 2, 5));
  251. Pen.Color:=clFuchsia;
  252. XX := XX + KrX;
  253. yy := yy - KrY;
  254. End;
  255. Pen.Style := psSolid;// Малюємо плаваючі осі----------
  256. Pen.Color := clGreen;
  257. Pen.Width := SpinEdit2.Value;
  258. MoveTo(L, Round(Ky * Gy + Zy));
  259. LineTo(Round(Width - L), Round(Ky * Gy + Zy));
  260. MoveTo(Round(Kx * Gx + Zx), L);
  261. LineTo(Round(Kx * Gx + Zx), Round( Height - L));
  262. Pen.Width:=SpinEdit1.Value;
  263. Pen.Color:=clFuchsia;
  264. MoveTo(Round(Kx * Xe[0]+Zx), Round(Ky * Ye[0] + Zy));
  265. For i := 0 to Ne - 1 do
  266. LineTo(Round(Kx * Xe[i]+Zx), Round(Ky * Ye[i] + zy));
  267. Pen.Width:=SpinEdit4.Value;
  268. Pen.Color:=clGreen;
  269. MoveTo(Round (Kx*Xe[0]+Zx),Round(Ky*Yg[0]+Zy));
  270. For i:=0 to Ne-1 do
  271. LineTo(Round (Kx*Xe[i]+Zx),Round(Ky*Yg[i]+Zy));
  272. end;
  273. ShowMessage('Показати гармоніки ?');
  274. Image1.Picture := nil;
  275. Garm(Ng, c);
  276. end;
  277. end;
  278.  
  279. procedure TForm1.Button2Click(Sender: TObject);
  280. begin
  281.   Close();
  282. end;
  283.  
  284. procedure TForm1.Edit3Change(Sender: TObject);
  285. begin
  286.  
  287. end;
  288.  
  289. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement