Advertisement
daniv1

Untitled

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